home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / chemie / sysiph12 / esr / sysiph12.lst < prev    next >
Encoding:
File List  |  1990-04-10  |  105.0 KB  |  4,688 lines
  1. HIDEM
  2. OPTION BASE 0
  3. GOSUB datenordner
  4. CLR bitmuster$
  5. FOR i=1 TO 37
  6.   READ zeilenmuster
  7.   bitmuster$=bitmuster$+MKI$(zeilenmuster)
  8. NEXT i
  9. DEFMOUSE bitmuster$
  10. DATA 7,7,1,0,1
  11. ' MASKENMUSTER
  12. DATA &X0000001000000000
  13. DATA &X0000011100000000
  14. DATA &X0000111110000000
  15. DATA &X0000111110000000
  16. DATA &X0001111111000000
  17. DATA &X0001111111000000
  18. DATA &X0011111111000000
  19. DATA &X1111101111000111
  20. DATA &X1111001111011111
  21. DATA &X0000001111111100
  22. DATA &X0000001111111000
  23. DATA &X0000001111111000
  24. DATA &X0000000111110000
  25. DATA &X0000000111110000
  26. DATA &X0000000011100000
  27. DATA &X0000000001000000
  28. ' CURSOR MUSTER
  29. '      1234567890123456
  30. DATA &X0000000000000000
  31. DATA &X0000001000000000
  32. DATA &X0000011100000000
  33. DATA &X0000011100000000
  34. DATA &X0000110110000000
  35. DATA &X0000110110000000
  36. DATA &X0001100110000000
  37. DATA &X0111000110000110
  38. DATA &X0110000110001110
  39. DATA &X0000000110011000
  40. DATA &X0000000110110000
  41. DATA &X0000000110110000
  42. DATA &X0000000011100000
  43. DATA &X0000000011100000
  44. DATA &X0000000001000000
  45. DATA &X0000000000000000
  46. esrordner:
  47. CHDIR "\ESR"
  48. IF EXIST("SYSIPHUS.PIC")
  49.   bild_da!=TRUE
  50.   OPEN "I",#1,"SYSIPHUS.PIC"
  51.   BLOAD "SYSIPHUS.PIC",XBIOS(2)
  52.   CLOSE #1
  53. ELSE
  54.   ALERT 1," |   WER HAT DENN DA | SCHON WIEDER KOPIERT ? ",1,"DAS WARS | WEITER",looser%
  55.   IF looser%=1
  56.     END
  57.   ELSE
  58.     CHDIR "\"
  59.     IF EXIST("SYSIPHUS.PIC")
  60.       NAME "SYSIPHUS.PIC" AS "\ESR\SYSIPHUS.PIC"
  61.       bild_da!=TRUE
  62.       GOTO esrordner
  63.     ENDIF
  64.   ENDIF
  65. ENDIF
  66. IF bild_da!=TRUE
  67.   DO
  68.     IF MOUSEK>0
  69.       maus=1
  70.     ENDIF
  71.     IF INKEY$>""
  72.       maus=1
  73.     ENDIF
  74.     EXIT IF maus=1
  75.   LOOP
  76. ENDIF
  77. '
  78. ' **********************************************************************
  79. ' ******************        SYSIPHUS 1.2         ***********************
  80. ' ******************   ESR-SIMULATIONSPROGRAMM   ***********************
  81. ' ******************  MIT VIEL MÜHE GESCHRIEBEN  ***********************
  82. ' ******************    VON Dr. GREGOR KRAFT     ***********************
  83. ' ******************       ANNO DOMINI 1989      ***********************
  84. ' **********************************************************************
  85. SHOWM
  86. ON BREAK GOSUB ende
  87. '
  88. CHDIR "\DATEN\"
  89. '
  90. OPENW 0                              ! Pull down - Menue erstellen
  91. DIM eintrag$(55)
  92. DO
  93.   READ eintrag$(i%)
  94.   EXIT IF eintrag$(i%)="****"
  95.   INC i%
  96. LOOP
  97. '
  98. DATA SYSIPHUS, INFO,------------------------,1,2,3,4,5,6,""
  99. DATA DATEI,LADEN,SPEICHERN,LOESCHEN,""
  100. DATA PARAMETER,ATOMGRUPPEN,KERNPARAMETER,SPEKTRUMPARAMETER,""
  101. DATA SPEKTRUM,SIMULATION,STICKLINE,HÜLLKURVE,""
  102. DATA OPTIONEN,FILENAME,ANDERE SWEEPWIDTH,AUSSCHNITT,STUPID,FORMATIEREN,VERGRÖßERN,g-WERT,""
  103. DATA BILDER,SCREENCOPY,HARDCOPY,PLOTTER,SIGNUM,""
  104. DATA ARBEIT,ANSCHAUEN,AUFSCHREIBEN,SPEKBEREICH,VERGLEICH,DIFFERENZ,""
  105. DATA INPUT,ESP300,MESS-SPEKTREN,""
  106. DATA ENDE,QUIT,"",""
  107. DATA ****
  108. MENU eintrag$()
  109. '
  110. auf=1024
  111. '
  112. ON MENU KEY GOSUB tasten
  113. ON MENU GOSUB auswahl
  114. '
  115. MENU 11,3
  116. MENU 12,3
  117. MENU 17,2
  118. MENU 21,2
  119. MENU 22,2
  120. MENU 23,2
  121. MENU 27,2
  122. MENU 28,2
  123. MENU 30,3
  124. MENU 31,2
  125. MENU 36,2
  126. MENU 37,2
  127. MENU 35,2
  128. MENU 38,2
  129. MENU 41,2
  130. MENU 42,2
  131. MENU 43,2
  132. MENU 44,2
  133. MENU 45,2
  134. '
  135. '
  136. neustart:
  137. rettung!=0
  138. ON ERROR GOSUB fehlerbehandlung
  139. '
  140. DO
  141.   ON MENU
  142.   '
  143.   GOSUB maus_abschalten
  144.   GOSUB maus_einschalten
  145. LOOP
  146. '
  147. '
  148. PROCEDURE auswahl                                ! Auswahl der Menues
  149.   DEFMOUSE bitmuster$
  150.   '
  151.   DEFFILL 0
  152.   PBOX 0,0,640,400
  153.   IF INSTR(eintrag$(MENU(0)),"INFO")
  154.     GOSUB information
  155.   ENDIF
  156.   '
  157.   IF INSTR(eintrag$(MENU(0)),"ATOMGRUPPEN")
  158.     GOSUB atom
  159.   ENDIF
  160.   ' '
  161.   '
  162.   IF INSTR(eintrag$(MENU(0)),"KERNPARAMETER")
  163.     GOSUB eingabe
  164.   ENDIF
  165.   '
  166.   IF INSTR(eintrag$(MENU(0)),"SPEKTRUMPARAMETER")
  167.     GOSUB spektrenparameter
  168.   ENDIF
  169.   '
  170.   IF INSTR(eintrag$(MENU(0)),"SIMULATION")
  171.     GOSUB hyper
  172.   ENDIF
  173.   '
  174.   IF INSTR(eintrag$(MENU(0)),"STICKLINE")
  175.     GOSUB bild
  176.   ENDIF
  177.   '
  178.   IF INSTR(eintrag$(MENU(0)),"ANDERE SWEEPWIDTH")
  179.     GOSUB messbereich
  180.   ENDIF
  181.   '
  182.   IF INSTR(eintrag$(MENU(0)),"HÜLLKURVE")
  183.     GOSUB linienform
  184.   ENDIF
  185.   '
  186.   IF INSTR(eintrag$(MENU(o)),"QUIT")
  187.     GOSUB ende
  188.   ENDIF
  189.   '
  190.   IF INSTR(eintrag$(MENU(0)),"LADEN")
  191.     GOSUB lese
  192.   ENDIF
  193.   '
  194.   IF INSTR(eintrag$(MENU(0)),"SPEICHERN")
  195.     GOSUB schreibe
  196.   ENDIF
  197.   '
  198.   IF INSTR(eintrag$(MENU(0)),"LOESCHEN")
  199.     GOSUB loesche
  200.   ENDIF
  201.   '
  202.   IF INSTR(eintrag$(MENU(0)),"FILENAME")
  203.     GOSUB namensgebung
  204.   ENDIF
  205.   '
  206.   IF INSTR(eintrag$(MENU(0)),"AUSSCHNITT")
  207.     GOSUB bereich
  208.   ENDIF
  209.   '
  210.   IF INSTR(eintrag$(MENU(0)),"STUPID")
  211.     GOSUB robot
  212.   ENDIF
  213.   '
  214.   IF INSTR(eintrag$(MENU(0)),"FORMATIEREN")
  215.     GOSUB format
  216.   ENDIF
  217.   '
  218.   IF INSTR(eintrag$(MENU(0)),"HARDCOPY")
  219.     GOSUB hardcopy
  220.   ENDIF
  221.   '
  222.   IF INSTR(eintrag$(MENU(0)),"VERGRÖßERN")
  223.     GOSUB aufblasen
  224.   ENDIF
  225.   '
  226.   IF INSTR(eintrag$(MENU(0)),"PLOTTER")
  227.     GOSUB hp7475a
  228.   ENDIF
  229.   '
  230.   IF INSTR(eintrag$(MENU(0)),"g-WERT")
  231.     GOSUB gwert
  232.   ENDIF
  233.   '
  234.   IF INSTR(eintrag$(MENU(0)),"SCREENCOPY")
  235.     GOSUB pixel
  236.   ENDIF
  237.   '
  238.   IF INSTR(eintrag$(MENU(0)),"SIGNUM")
  239.     GOSUB sichnum
  240.   ENDIF
  241.   '
  242.   IF INSTR(eintrag$(MENU(0)),"ANSCHAUEN")
  243.     GOSUB espspektrum
  244.   ENDIF
  245.   '
  246.   IF INSTR(eintrag$(MENU(0)),"AUFSCHREIBEN")
  247.     GOSUB messchreiben
  248.   ENDIF
  249.   '
  250.   IF INSTR(eintrag$(MENU(0)),"SPEKBEREICH")
  251.     GOSUB spekmessbereich
  252.   ENDIF
  253.   '
  254.   IF INSTR(eintrag$(MENU(0)),"VERGLEICH")
  255.     GOSUB simmess
  256.   ENDIF
  257.   '
  258.   IF INSTR(eintrag$(MENU(0)),"DIFFERENZ")
  259.     GOSUB differenz
  260.   ENDIF
  261.   '
  262.   IF INSTR(eintrag$(MENU(0)),"ESP300")
  263.     GOSUB esp300
  264.   ENDIF
  265.   '
  266.   IF INSTR(eintrag$(MENU(0)),"MESS-SPEKTREN")
  267.     GOSUB messlese
  268.   ENDIF
  269.   '
  270.   '
  271.   MENU OFF
  272. RETURN
  273. '
  274. '
  275. PROCEDURE maus_abschalten
  276.   DPOKE GINTIN,3
  277.   GEMSYS 107
  278.   maus_ist_aus!=TRUE
  279. RETURN
  280. '
  281. PROCEDURE maus_einschalten
  282.   DPOKE GINTIN,2
  283.   GEMSYS 107
  284.   maus_ist_aus!=FALSE
  285. RETURN
  286. '
  287. PROCEDURE ende
  288.   IF maus_ist_aus!=TRUE
  289.     GOSUB maus_einschalten
  290.   ENDIF
  291.   ALERT 2," | PROGRAMM WIRKLICH | BEENDEN ? ",1," S'LANGT | OH GOTT!",anfra%
  292.   IF anfra%=2
  293.     GOTO heschel
  294.   ENDIF
  295.   MENU KILL
  296.   END
  297.   heschel:
  298. RETURN
  299. '
  300. PROCEDURE information
  301.   MENU OFF
  302.   LOCAL maus%
  303.   BOX 100,50,540,350
  304.   BOX 105,55,535,345
  305.   DEFTEXT 1,17,0,16
  306.   TEXT 150,80,340,"PROVINZ-SOFT PRESENT"
  307.   DEFTEXT 1,11,0,24
  308.   TEXT 180,120,280,"SYSIPHUS 1.2"
  309.   DEFTEXT 1,0,0,13
  310.   TEXT 150,160,340," EIN BRAUCHBARES ESR-SIMULATIONSPROGRAMM "
  311.   TEXT 150,180,340,"      FÜR EINEN BRAUCHBAREN COMPUTER     "
  312.   TEXT 150,200,340,"         GESCHRIEBEN IN GFA-BASIC        "
  313.   DEFTEXT 1,16,0,13
  314.   TEXT 150,220,340,"         ANNO DOMINI 1989        "
  315.   DEFTEXT 1,0,0,13
  316.   TEXT 150,240,340," VON DR.GREGOR KRAFT; JAHNSTR.2,6701 MAXDORF "
  317.   TEXT 150,260,340,"DIESES PROGRAMM IST FREEWARE UND DARF FREI"
  318.   TEXT 150,280,340,"KOPIERT WERDEN ! MÖGE ES VON NUTZEN SEIN !"
  319.   BOX 250,290,390,320
  320.   TEXT 270,310,100," SO ISSES "
  321.   DO
  322.     IF MOUSEX>250 AND MOUSEX<390 AND MOUSEY>290 AND MOUSEY<320 AND MOUSEK=1
  323.       maus%=1
  324.     ENDIF
  325.     IF INKEY$=CHR$(13)
  326.       maus%=1
  327.     ENDIF
  328.     EXIT IF maus%=1
  329.   LOOP
  330.   CLS
  331.   ' ********************************************************************
  332.   BOX 100,50,540,350
  333.   BOX 105,55,535,345
  334.   DEFTEXT 1,8,0,13
  335.   TEXT 150,80,340,"UNTERSAGT IST DIE GEWERBLICHE NUTZUNG !!"
  336.   TEXT 150,120,340," AUSDRÜCKLICH UNTERSAGT IST DIE NUTZUNG "
  337.   TEXT 150,140,340,"DES PROGRAMMS DURCH DIE FIRMA BRUKER GMBH"
  338.   DEFTEXT 1,0,0,13
  339.   TEXT 150,160,340,"VERÄNDERUNGEN AN DIESEM PROGRAMM BEDÜRFEN"
  340.   TEXT 150,180,340,"   MEINER AUSDRÜCKLICHEN GENEHMIGUNG     "
  341.   TEXT 150,220,340," DIE WEITERGABE DIESES PROGRAMMS IST NUR MIT"
  342.   TEXT 150,240,340," DEN DATEIEN SYSIPHUS.TXT UND SYSIPHUS.SDO  "
  343.   TEXT 150,260,340,"       GESTATTET (UND AUCH SINNVOLL)        "
  344.   BOX 250,290,390,320
  345.   TEXT 270,310,100," NA KLAR "
  346.   maus%=0
  347.   DO
  348.     IF MOUSEX>250 AND MOUSEX<390 AND MOUSEY>290 AND MOUSEY<320 AND MOUSEK=1
  349.       maus%=1
  350.     ENDIF
  351.     IF INKEY$=CHR$(13)
  352.       maus%=1
  353.     ENDIF
  354.     EXIT IF maus%=1
  355.   LOOP
  356.   CLS
  357. RETURN
  358. '
  359. '
  360. PROCEDURE messbereich                   ! Eingabe der Sweep-Width (wenn andere
  361.   MENU OFF
  362.   LOCAL s,maus%
  363.   DEFTEXT 1,0,0,13                      ! sweep-width im Prog.-ablauf gewünscht
  364.   PRINT AT(20,10);"SWEEP-WIDTH :___________|____________"  !wird
  365.   PRINT AT(35,10);sweep
  366.   BOX 250,300,350,330
  367.   PRINT AT(36,20);"OK?"
  368.   BOX 250,143,450,160
  369.   DO
  370.     IF ((250<MOUSEX AND 450>MOUSEX) AND (143<MOUSEY AND 160>MOUSEY) AND MOUSEK=1)
  371.       maus%=1
  372.     ENDIF
  373.     IF ((250<MOUSEX AND 350>MOUSEX) AND (300<MOUSEY AND 350>MOUSEY) AND MOUSEK=1)
  374.       maus%=2
  375.     ENDIF
  376.     EXIT IF maus%<>0
  377.   LOOP
  378.   IF maus%=1
  379.     PRINT AT(47,10);
  380.     INPUT s
  381.     sweep=ABS(s)
  382.     PRINT AT(35,10);sweep
  383.   ENDIF
  384.   CLS
  385.   IF spektrum!=TRUE
  386.     GOSUB bild
  387.   ELSE
  388.     GOSUB zeichnung
  389.   ENDIF
  390. RETURN
  391. '
  392. PROCEDURE spektrenparameter              ! Eingabe der Auflösung,
  393.   MENU OFF
  394.   BOX 40,20,600,360                      ! der Halbwerstbreite und
  395.   DEFFILL 1,1                            ! der Sweep-Width
  396.   PBOX 250,60,350,90
  397.   PBOX 250,300,350,330
  398.   LOCAL sw$,halbwert$,sw1,auf1,halbwertsbreite,maus%,button%,bu%,butt%
  399.   auf1=auf
  400.   sw1=sw
  401.   halbwertsbreite=halbwert
  402.   GRAPHMODE 2
  403.   DEFTEXT 0,0,0,13
  404.   TEXT 180,50,250,"AUFLÖSUNG"
  405.   TEXT 270,320,60,"OK?"
  406.   GRAPHMODE 1
  407.   DEFTEXT 1,0,0,13
  408.   BOX 60,125,160,155
  409.   TEXT 70,145,80,"1024"
  410.   BOX 204,125,304,155
  411.   TEXT 214,145,80,"2048"
  412.   BOX 344,125,444,155
  413.   TEXT 355,145,80,"4096"
  414.   BOX 490,125,590,155
  415.   TEXT 500,145,80,"8192"
  416.   PRINT AT(36,5);auf1
  417.   BOX 265,207,455,227
  418.   BOX 265,237,455,258
  419.   PRINT AT(10,13);"SIMULATIONS"
  420.   PRINT AT(10,14);"SWEEP-WIDTH IN GAUß     :___________|___________"
  421.   PRINT AT(10,16);"HALBWERTSBREITE IN GAUß :___________|___________"
  422.   PRINT AT(37,14);sw1
  423.   PRINT AT(37,16);halbwertsbreite
  424.   mehr:
  425.   maus%=0
  426.   DO
  427.     IF ((265<MOUSEX AND 455>MOUSEX) AND (207<MOUSEY AND 227>MOUSEY) AND MOUSEK=1)
  428.       maus%=3
  429.     ENDIF
  430.     IF ((265<MOUSEX AND 455>MOUSEX) AND (237<MOUSEY AND 258>MOUSEY) AND MOUSEK=1)
  431.       maus%=4
  432.     ENDIF
  433.     IF INKEY$=CHR$(13)
  434.       maus%=2
  435.     ENDIF
  436.     IF ((250<MOUSEX AND 350>MOUSEX) AND (300<MOUSEY AND 330>MOUSEY) AND MOUSEK=1)
  437.       maus%=2
  438.     ENDIF
  439.     IF ((60<MOUSEX AND 160>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
  440.       maus%=1
  441.       auf=1024
  442.     ENDIF
  443.     IF ((204<MOUSEX AND 304>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
  444.       maus%=1
  445.       auf=2048
  446.     ENDIF
  447.     IF ((344<MOUSEX AND 444>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
  448.       maus%=1
  449.       auf=4096
  450.     ENDIF
  451.     IF ((490<MOUSEX AND 590>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
  452.       maus%=1
  453.       auf=8192
  454.     ENDIF
  455.     EXIT IF maus%>0
  456.   LOOP
  457.   IF maus%=1
  458.     IF auf1<>auf
  459.       IF (simgauss%+simlorentz%+simgauss_lorentz%)>0
  460.         ALERT 3," ÄNDERUNG DER AUFLÖSUNG | BEDINGT DAS LÖSCHEN DER | SIMULIERTEN GAUß-  UND | LORENTZKURVE ",1," ABBRUCH | WEITER ",button%
  461.         IF button%=2
  462.           auf1=auf
  463.           simgauss%=0
  464.           simlorentz%=0
  465.           simgauss_lorentz%=0
  466.           ERASE huelk%()
  467.           MENU 27,2
  468.           MENU 28,2
  469.         ELSE
  470.           auf=auf1
  471.         ENDIF
  472.       ELSE
  473.         auf1=auf
  474.       ENDIF
  475.     ENDIF
  476.     PRINT AT(36,5);auf1
  477.     GOTO mehr
  478.   ENDIF
  479.   IF maus%=3
  480.     PRINT AT(48,14);
  481.     FORM INPUT 7,sw$
  482.     sw=ABS(VAL(sw$))
  483.     IF sw1<>sw
  484.       IF (simgauss%+simlorentz%+simgauss_lorentz%)>0
  485.         ALERT 3," ÄNDERUNG DER SWEEP-WIDTH | BEDINGT DAS LÖSCHEN DER | SIMULIERTEN GAUß-  UND | LORENTZKURVE ",1," ABBRUCH | WEITER ",butt%
  486.         IF butt%=2
  487.           sw1=sw
  488.           ERASE huelk%()
  489.           simgauss%=0
  490.           simlorentz%=0
  491.           simgauss_lorentz%=0
  492.           MENU 27,2
  493.           MENU 28,2
  494.           MENU 31,2
  495.           MENU 36,2
  496.           MENU 37,2
  497.           MENU 38,2
  498.           MENU 44,2
  499.         ELSE
  500.           sw=sw1
  501.         ENDIF
  502.       ELSE
  503.         sw1=sw
  504.         sweep=sw
  505.       ENDIF
  506.     ENDIF
  507.     PRINT AT(37,14);"_________";
  508.     PRINT AT(37,14);sw1;
  509.     GOTO mehr
  510.   ENDIF
  511.   IF maus%=4
  512.     PRINT AT(48,16);
  513.     FORM INPUT 7,halbwert$
  514.     halbwert=ABS(VAL(halbwert$))
  515.     IF halbwertsbreite<>halbwert
  516.       IF (simgauss%+simlorentz%+simgauss_lorentz%)>0
  517.         ALERT 3," ÄNDERUNG DES HALBWERTSBREITE | BEDINGT DAS LÖSCHEN DER | SIMULIERTEN GAUß-  UND | LORENTZKURVE ",1," ABBRUCH | WEITER ",bu%
  518.         IF bu%=2
  519.           halbwertsbreite=halbwert
  520.           ERASE huelk%()
  521.           simgauss%=0
  522.           simlorentz%=0
  523.           simgauss_lorentz%=0
  524.           MENU 28,2
  525.           MENU 27,2
  526.           MENU 31,2
  527.           MENU 36,2
  528.           MENU 37,2
  529.           MENU 38,2
  530.           MENU 44,2
  531.         ELSE
  532.           halbwert=halbwertsbreite
  533.         ENDIF
  534.       ELSE
  535.         halbwertsbreite=halbwert
  536.       ENDIF
  537.     ENDIF
  538.     PRINT AT(37,16);"_________";
  539.     PRINT AT(37,16);halbwert
  540.     GOTO mehr
  541.   ENDIF
  542.   CLS
  543. RETURN
  544. '
  545. PROCEDURE tasten                          !Tastenbelegung
  546.   LOCAL scancode%
  547.   scancode%=SHR(MENU(14),8)
  548.   asc%=ASC(t$)
  549.   IF scancode%=68
  550.     GOSUB ende
  551.   ENDIF
  552.   IF scancode%=67
  553.     GOSUB rausch
  554.   ENDIF
  555.   IF scancode%=60
  556.     GOSUB laufwerk
  557.   ENDIF
  558. RETURN
  559. '
  560. '
  561. '
  562. '  *************************************************************************
  563. '
  564. PROCEDURE atom                !Eingabe der Zahl der Unabhängigen Atomgruppen
  565.   MENU OFF
  566.   LOCAL maus,nik$,nikaerst%,button%
  567.   eingabe:
  568.   maus=0
  569.   nikaerst%=nika%
  570.   BOX 80,200,280,230
  571.   BOX 320,200,520,230
  572.   DEFTEXT 1,9,0,16
  573.   TEXT 85,223,180,"EINGABE OK?"
  574.   TEXT 325,223,180,"ÄNDERN?"
  575.   DEFTEXT 1,0,0,13
  576.   PRINT AT(20,10);"UNABHÄNGIGE ATOMGRUPPEN:_____|___";""
  577.   PRINT AT(47,10);nika%
  578.   IF nika%=0
  579.     GOTO hinein
  580.   ENDIF
  581.   DO
  582.     IF INKEY$=CHR$(13)
  583.       maus=1
  584.     ENDIF
  585.     IF ((85<MOUSEX AND 275>MOUSEX) AND (205<MOUSEY AND 225>MOUSEY)) AND MOUSEK=1
  586.       maus=1
  587.     ENDIF
  588.     IF ((325<MOUSEX AND 515>MOUSEX) AND (205<MOUSEY AND 225>MOUSEY)) AND MOUSEK=1
  589.       maus=2
  590.     ENDIF
  591.     EXIT IF maus>0
  592.   LOOP
  593.   IF maus=1
  594.     GOTO atomende
  595.   ENDIF
  596.   hinein:
  597.   PRINT AT(50,10);
  598.   FORM INPUT 2,nik$
  599.   PRINT AT(43,10);":__________"
  600.   PRINT AT(47,10);nika%
  601.   nika%=FIX(ABS(VAL(nik$)))
  602.   PRINT AT(47,10);nika%
  603.   IF nika%=0
  604.     GOTO eingabe
  605.   ENDIF
  606.   IF nikaerst%>0
  607.     IF nikaerst%<>nika%
  608.       ALERT 3," ÄNDERN DER ZAHL DER | UNABHÄNGIGEN ATOMGRUPPEN | BEDINGT DAS LÖSCHEN DER | SIMULIERTEN SPEKTREN ",1,"ABBRUCH | WEITER ",button%
  609.       IF button%=1
  610.         nika%=nikaerst%
  611.         GOTO eingabe
  612.       ENDIF
  613.       ERASE ag1()
  614.       ERASE ag()
  615.       ERASE at$()
  616.       ERASE hy()
  617.       ERASE intensi()
  618.       ERASE huelk%()
  619.       simgauss%=0
  620.       simlorentz%=0
  621.       simgauss_lorentz%=0
  622.       simstick%=0
  623.       MENU 21,2
  624.       MENU 22,2
  625.       MENU 23,2
  626.       MENU 27,2
  627.       MENU 28,2
  628.       MENU 31,2
  629.       MENU 36,2
  630.       MENU 37,2
  631.       MENU 38,2
  632.       MENU 44,2
  633.     ELSE
  634.       GOTO eingabe
  635.     ENDIF
  636.   ENDIF
  637.   nikaerst%=nika%
  638.   DIM ag(nika%,2)
  639.   DIM at$(nika%,2)
  640.   DIM ag1(nika%,2)
  641.   GOTO eingabe
  642.   atomende:
  643.   CLS
  644.   MENU 17,3
  645. RETURN
  646. '
  647. ' **************************************************************************
  648. '
  649. PROCEDURE eingabe      ! Eingabe der Kernparameter; Spin,Anzahl und Kopplungs-
  650.   MENU OFF
  651.   DEFFILL 1,1          ! konstante
  652.   LOCAL k%,maus,but%,butt%,j%
  653.   PBOX 25,330,450,360
  654.   PBOX 200,100,250,120
  655.   GRAPHMODE 2
  656.   DEFTEXT 0,1,0,13
  657.   TEXT 50,350,350,"ZUM ÄNDERN DER DATEN: RECHTE MAUSTASTE !"
  658.   TEXT 205,115,50," OK ? "
  659.   GRAPHMODE 1
  660.   BOX 25,20,450,360
  661.   FOR k%=1 TO nika%
  662.     ein:
  663.     maus=0
  664.     DEFTEXT 1,20,0,10,
  665.     TEXT 50,300,400,"Eingabe in Ordnung?"
  666.     DEFTEXT 1,0,0,6
  667.     BOX 127,307,190,327
  668.     TEXT 50,320,380,"weiter mit  return!  korrektur mit beliebiger Taste"
  669.     BOX 70,100,100,120
  670.     BOX 350,100,380,120
  671.     TEXT 80,112,15,"<="
  672.     TEXT 360,112,15,"=>"
  673.     DEFTEXT 1,16,0,13
  674.     TEXT 100,50,300,"K E R N P A R A M E T E R"
  675.     DEFTEXT 1,0,0,13
  676.     PRINT AT(10,5);"Atomgruppe ";k%;" von ";nika%;" unabhängigen Atomgruppen"
  677.     PRINT AT(10,10);"spin....................:__________"
  678.     PRINT AT(36,10);ag(k%,0)
  679.     PRINT AT(10,12);"Anzahl der äquivalenten"
  680.     PRINT AT(10,13);"Atome dieser Gruppe......:__________"
  681.     PRINT AT(36,13);ag(k%,1)
  682.     PRINT AT(10,16);"Kopplungskonstante......:__________"
  683.     PRINT AT(36,16);ag(k%,2)
  684.     '
  685.     IF (ag(k%,0)=0 OR ag(k%,1)=0 OR ag(k%,2)=0)
  686.       GOTO ein1
  687.     ENDIF
  688.     '
  689.     DO
  690.       IF ((127<MOUSEX AND 185>MOUSEX) AND (310<MOUSEY AND 326>MOUSEY) AND MOUSEK=1)
  691.         maus=1
  692.       ENDIF
  693.       IF (INKEY$<>"") OR MOUSEK=2
  694.         maus=2
  695.       ENDIF
  696.       IF ((75<MOUSEX AND 95>MOUSEX) AND (100<MOUSEY AND 120>MOUSEY) AND MOUSEK=1)
  697.         maus=3
  698.       ENDIF
  699.       IF ((355<MOUSEX AND 375>MOUSEX) AND (100<MOUSEY AND 120>MOUSEY) AND MOUSEK=1)
  700.         maus=4
  701.       ENDIF
  702.       IF ((200<MOUSEX AND 250>MOUSEX) AND (100<MOUSEY AND 120>MOUSEY) AND MOUSEK=1)
  703.         maus=5
  704.       ENDIF
  705.       EXIT IF maus<>0
  706.     LOOP
  707.     IF maus=1
  708.       GOTO naexte
  709.     ENDIF
  710.     '
  711.     IF maus=3
  712.       k%=k%-2
  713.       IF k%<0
  714.         k%=nika%-1
  715.       ENDIF
  716.       GOTO naexte
  717.     ENDIF
  718.     IF maus=4
  719.       IF k%=nika%
  720.         k%=0
  721.       ENDIF
  722.       GOTO naexte
  723.     ENDIF
  724.     IF maus=5
  725.       k%=nika%
  726.       GOTO naexte
  727.     ENDIF
  728.     ein1:
  729.     '
  730.     MENU 21,3
  731.     PRINT AT(35,10);"?"
  732.     PRINT AT(36,10);
  733.     FORM INPUT 10 AS at$(k%,0)
  734.     PRINT AT(35,10);" "
  735.     ag1(k%,0)=VAL(at$(k%,0))
  736.     PRINT AT(35,13);"?"
  737.     PRINT AT(36,13);
  738.     FORM INPUT 10 AS at$(k%,1)
  739.     PRINT AT(35,13);" "
  740.     ag1(k%,1)=FIX(ABS(VAL(at$(k%,1))))
  741.     PRINT AT(35,16);"?"
  742.     PRINT AT(36,16);
  743.     FORM INPUT 10 AS at$(k%,2)
  744.     PRINT AT(35,16);" "
  745.     ag1(k%,2)=ABS(VAL(at$(k%,2)))
  746.     i_np=INP(2)
  747.     IF i_np<>13
  748.       GOTO ein1
  749.     ENDIF
  750.     '
  751.     '         *************************** Abfrage ob die Eingegebenen Daten
  752.     IF ag1(k%,0)=0 OR ag1(k%,1)=0 OR ag1(k%,2)=0  ! mit der Programmsyntax
  753.       GOTO ein1                                ! verträglich sind
  754.     ENDIF
  755.     '
  756.     IF ag1(k%,0)<>1 AND ag1(k%,0)<>0.5
  757.       IF FRAC(2*ag1(k%,0))<>0
  758.         ALERT 1,"   DEN ' SPINNERTEN' SPINN |  KENNEN MER NET !  ",1," ZURÜCK | WEITER ",butt%
  759.         IF butt%<>1
  760.           ALERT 3," ORGANIKER ?? ",1," ZURÜCK ",button%
  761.           GOTO ein1
  762.         ENDIF
  763.         GOTO ein1
  764.       ENDIF
  765.     ENDIF
  766.     '
  767.     ' ***********************************************************************
  768.     '
  769.     IF ag(k%,0)<>0 OR ag(k%,1)<>0 OR ag(k%,2)<>0
  770.       IF ag1(k%,0)<>ag(k%,0) OR ag1(k%,1)<>ag(k%,1) OR ag1(k%,2)<>ag(k%,2)
  771.         ALERT 1," ÄNDERN DER PARAMETER | HAT DAS LÖSCHEN DER | SIMULIERTEN SPEKTREN  |  ZURFOLGE !",1,"ABBRUCH | WEITER ",but%
  772.         IF but%=2
  773.           FOR j%=0 TO 2
  774.             ag(k%,j%)=ag1(k%,j%)
  775.             at$(k%,j%)=STR$(ag1(k%,j%))
  776.           NEXT j%
  777.           ERASE hy()
  778.           ERASE intensi()
  779.           ERASE huelk%()
  780.           simgauss%=0
  781.           simlorentz%=0
  782.           simgauss_lorentz%=0
  783.           simstick%=0
  784.           MENU 22,2
  785.           MENU 23,2
  786.           MENU 21,3
  787.           MENU 27,2
  788.           MENU 28,2
  789.           MENU 31,2
  790.           MENU 36,2
  791.           MENU 37,2
  792.           MENU 38,2
  793.           MENU 44,2
  794.         ENDIF
  795.         FOR j%=0 TO 2
  796.           at$(k%,j%)=STR$(ag(k%,j%))
  797.         NEXT j%
  798.         GOTO ein
  799.       ENDIF
  800.     ENDIF
  801.     FOR j%=0 TO 2
  802.       ag(k%,j%)=ag1(k%,j%)
  803.       at$(k%,j%)=STR$(ag1(k%,j%))
  804.     NEXT j%
  805.     naexte:
  806.     PRINT AT(36,10);"                 "
  807.     PRINT AT(36,13);"                 "
  808.     PRINT AT(36,16);"                 "
  809.   NEXT k%
  810.   eingabeend:
  811.   CLS
  812. RETURN
  813. '
  814. PROCEDURE hyper     ! Berechnung der Linienzahl eines sim.Spektrums
  815.   MENU OFF
  816.   LOCAL n,k%,m,m%,i,j%,i%,g,x,z,y,x%,kleii,kleis
  817.   DEFTEXT 1,0,0,13
  818.   DIM zwn(nika%)
  819.   n=1
  820.   DEFTEXT 1,0,0,13
  821.   FOR k%=1 TO nika%
  822.     zwn(k%)=2*ag(k%,0)*ag(k%,1)+1
  823.     PRINT "linien der Gruppe ",k%,zwn(k%)
  824.     n=n*zwn(k%)
  825.   NEXT k%
  826.   PRINT "anzahl der Linien N=",n
  827.   FOR k%=1 TO nika%
  828.     IF zwn(k%)>m
  829.       m=zwn(k%)
  830.     ENDIF
  831.   NEXT k%
  832.   '                             ! Zuordnung der Intensitäten zu den einzelnen
  833.   '                             ! Kopplungen innerhalb einer Atomgruppe
  834.   DIM hyp(nika%,m),int(nika%,m)
  835.   ARRAYFILL hyp(),0
  836.   FOR k%=1 TO nika%
  837.     d=(zwn(k%)-1)/2
  838.     FOR g=zwn(k%) DOWNTO 1
  839.       hyp(k%,g)=d*ag(k%,2)
  840.       d=d-1
  841.     NEXT g
  842.     GOSUB spin
  843.   NEXT k%
  844.   MENU 21,2
  845.   hyperfine:   !Hyperfine-Aufspaltung des gesammten Spektrums incl. Intensitäten
  846.   DIM h(n),hy(n),intensi(n),in(n)
  847.   FOR i%=1 TO n
  848.     h(i%)=0
  849.     in(i%)=1
  850.   NEXT i%
  851.   z=1
  852.   FOR k%=1 TO nika%
  853.     x=0
  854.     FOR m=1 TO z
  855.       FOR g=1 TO zwn(k%)
  856.         INC x
  857.         hy(x)=h(m)+hyp(k%,g)
  858.         intensi(x)=in(m)*int(k%,g)
  859.       NEXT g
  860.     NEXT m
  861.     z=z*zwn(k%)
  862.     FOR x=1 TO z
  863.       h(x)=hy(x)
  864.       in(x)=intensi(x)
  865.     NEXT x
  866.   NEXT k%
  867.   '
  868.   '
  869.   reduzierung:  !Reduzierung der Gesamtlinienzahl auf die beobachtbaren Linien
  870.   '
  871.   '
  872.   centerfield=10000    ! Da eh nicht absolut gerechnet werden kann ist center-
  873.   FOR x=1 TO n         ! field so gewählt, daß immer (im Normalfall) die Auf-
  874.     h(x)=h(x)+centerfield ! spaltungen im positiven Bereich sind.
  875.   NEXT x
  876.   ARRAYFILL hy(),0
  877.   ARRAYFILL intensi(),0
  878.   m=0
  879.   FOR x=1 TO n
  880.     IF h(x)=0
  881.     ELSE
  882.       ADD m,1
  883.       hy(m)=h(x)
  884.       intensi(m)=intensi(x)
  885.       FOR y=x TO n
  886.         IF hy(m)=h(y)
  887.           h(y)=0
  888.           ~FRE()
  889.           ADD intensi(m),in(y)
  890.         ENDIF
  891.       NEXT y
  892.     ENDIF
  893.   NEXT x
  894.   b=m
  895.   '
  896.   IF b<n
  897.     PRINT " ZUFÄLLIGE ENTARTUNG : NUR NOCH ";b;"-LINIEN ZU SEHEN"
  898.     SWAP h(),hy()
  899.     SWAP in(),intensi()
  900.     ERASE intensi(),hy()
  901.     DIM hy(b),intensi(b)
  902.     FOR x%=1 TO b
  903.       ~FRE()
  904.       hy(x%)=h(x%)
  905.       intensi(x%)=in(x%)
  906.     NEXT x%
  907.   ENDIF
  908.   ' *********  Sortierung der Hyperfine-Aufspaltung nach der Größe *******
  909.   intmax=0
  910.   intmin=1
  911.   FOR m=1 TO b
  912.     kleis=hy(m)
  913.     kleii=intensi(m)
  914.     FOR x=m TO b
  915.       ~FRE()
  916.       IF hy(x)<kleis
  917.         hy(m)=hy(x)
  918.         hy(x)=kleis
  919.         kleis=hy(m)
  920.         intensi(m)=intensi(x)
  921.         intensi(x)=kleii
  922.         kleii=intensi(m)
  923.       ENDIF
  924.     NEXT x
  925.   NEXT m
  926.   m%=0
  927.   DO
  928.     INC m%
  929.     IF intmax<intensi(m%)
  930.       intmax=intensi(m%)
  931.       IF intmin>intensi(m%)
  932.         intmin=intensi(m%)
  933.       ENDIF
  934.     ENDIF
  935.     EXIT IF m%=b
  936.   LOOP
  937.   MENU 22,3
  938.   MENU 23,3
  939.   simstick%=1
  940.   ERASE in(),zwn(),h(),hyp(),int()
  941. RETURN
  942. '
  943. PROCEDURE bild                ! Zeichnung eines Stick-Line-Spektrums
  944.   MENU OFF
  945.   CLS
  946.   LOCAL null,fak,weite,m
  947.   IF sweep=0
  948.     IF sw=0
  949.       ALERT 3," |    |  SWEEP-WIDTH IST 0 ! ",1," ABBRUCH ",button%
  950.       GOTO bildend
  951.     ENDIF
  952.     sweep=sw
  953.   ENDIF
  954.   null=centerfield-sweep*0.5
  955.   fak=587/sweep
  956.   DEFLINE 1,2,0,0
  957.   BOX 27,60,613,360
  958.   LINE 27,360,27,365
  959.   LINE 321,360,321,365
  960.   LINE 613,360,613,365
  961.   DEFTEXT 1,0,0,6
  962.   PRINT AT(3,2);"Filename: ";finame$;
  963.   PRINT AT(3,80);"0.0";
  964.   PRINT AT(40,80);sweep*0.5;
  965.   PRINT AT(75,80);sweep;
  966.   FOR m=1 TO b
  967.     weite=(hy(m)-null)*fak
  968.     IF weite<0
  969.       GOTO weiter
  970.     ENDIF
  971.     DEFLINE 1,0,0,0
  972.     LINE 27+weite,intensi(m)*100/intmax+210,27+weite,210-intensi(m)*100/intmax
  973.     weiter:
  974.   NEXT m
  975.   spektrum!=TRUE
  976.   MENU 27,3
  977.   HIDEM
  978.   SGET x1$
  979.   SHOWM
  980.   MENU 35,3
  981.   MENU 36,3
  982.   IF mess!=-1
  983.     MENU 44,3
  984.   ENDIF
  985.   simm!=-1
  986.   simess!=0
  987.   messplo!=0
  988.   bildend:
  989. RETURN
  990. '
  991. PROCEDURE linienform          ! Initialisierung der Hüllkurvenform
  992.   MENU OFF
  993.   LOCAL maus%,bib%,butt%,but%,button%,prog,l%
  994.   CLS
  995.   simkurve%=simgauss%+simlorentz%+simgauss_lorentz%
  996.   IF f_ormstupid!=TRUE
  997.     GOTO simstupid
  998.   ENDIF
  999.   linformein:
  1000.   maus%=0
  1001.   DEFTEXT 1,0,0,13
  1002.   BOX 40,40,600,350
  1003.   BOX 110,90,530,120
  1004.   TEXT 120,110,200,"AKTUELLE EINSTELLUNG :"
  1005.   TEXT 330,110,190,kurform$
  1006.   BOX 90,170,190,210
  1007.   TEXT 100,197,80,"GAUß"
  1008.   BOX 450,170,550,210
  1009.   TEXT 455,197,90,"GAUß/LORENTZ"
  1010.   BOX 270,170,370,210
  1011.   TEXT 280,197,80,"LORENTZ"
  1012.   GRAPHMODE 2
  1013.   DEFFILL 1,1
  1014.   PBOX 250,300,350,330
  1015.   DEFTEXT 0,0,0,13
  1016.   TEXT 280,320,50,"OK?"
  1017.   GRAPHMODE 1
  1018.   DEFTEXT 1,1,0,13
  1019.   DO
  1020.     IF ((90<MOUSEX AND 190>MOUSEX) AND (170<MOUSEY AND 210>MOUSEY) AND MOUSEK=1)
  1021.       kurve%=1
  1022.       maus%=1
  1023.       LET kurform$="GAUßKURVE"
  1024.     ENDIF
  1025.     IF ((270<MOUSEX AND 370>MOUSEX) AND (170<MOUSEY AND 210>MOUSEY) AND MOUSEK=1)
  1026.       maus%=2
  1027.       kurve%=2
  1028.       kurform$="LORENTZKURVE"
  1029.       prol=1
  1030.     ENDIF
  1031.     IF ((450<MOUSEX AND 550>MOUSEX) AND (170<MOUSEY AND 210>MOUSEY) AND MOUSEK=1)
  1032.       maus%=3
  1033.       kurve%=3
  1034.       kurform$="GAUß/LORENTZ-KURVE"
  1035.     ENDIF
  1036.     IF kurve%>0
  1037.       IF INKEY$=CHR$(13)
  1038.         maus%=4
  1039.       ENDIF
  1040.       IF ((250<MOUSEX AND 350>MOUSEX) AND (300<MOUSEY AND 330>MOUSEY) AND MOUSEK=1)
  1041.         maus%=4
  1042.       ENDIF
  1043.     ENDIF
  1044.     EXIT IF maus%<>0
  1045.   LOOP
  1046.   IF maus%<4
  1047.     TEXT 330,110,200,"                           "
  1048.     GOTO linformein
  1049.   ENDIF
  1050.   simstupid:                    ! Überprüfen ob die Berechnung möglich ist
  1051.   IF simkurve%=0
  1052.     IF sw=0
  1053.       ALERT 3," | | SWEEP-WIDTH IST 0 !",1," ABBRUCH ",butt%
  1054.       GOTO huellend
  1055.     ENDIF
  1056.     IF halbwert=0
  1057.       ALERT 3," HALBWERTSBREITE IST NICHT | |    DEFINIERT ! ",1," ABBRUCH ",butt%
  1058.       GOTO huellend
  1059.     ENDIF
  1060.     ppg=auf/sw
  1061.     bip=(hy(b)-hy(1)+halbwert*20)*ppg
  1062.     IF bip<auf
  1063.       simsw=sw
  1064.       bi%=auf
  1065.     ELSE
  1066.       IF FRE(0)<bi%*24+150000
  1067.         ALERT 3,"           | ZU WENIG SPEICHERPLATZ | VORERST NUR ...  ",1," ABBRUCH ",but%
  1068.         GOTO huellend
  1069.       ENDIF
  1070.       bi%=INT(bip)
  1071.       IF 0=EVEN(bi%)
  1072.         INC bi%
  1073.       ENDIF
  1074.     ENDIF
  1075.     IF bi%*3>65000
  1076.       ALERT 3," ZU VIELE FELDELEMENTE ZUR | BERECHNUNG DER HÜLLKURVE |  VORERST NUR ...  ",1," ABBRUCH ",but%
  1077.       GOTO huellend
  1078.     ENDIF
  1079.     simsw=bi%*sw/auf
  1080.     DIM einh(1,bi%)
  1081.   ENDIF
  1082.   ppg=auf/sw
  1083.   IF halbwert*ppg<1.8
  1084.     ALERT 3," DAS WIRD SO NIX! | MAL HÖHERE AUFLÖßUNG NEHMEN | BZW. KLEINERE SWEEP-WIDTH ",1," ABBRUCH ",button%
  1085.     ERASE einh()
  1086.     GOTO huellend
  1087.   ENDIF
  1088.   IF kurve%=1
  1089.     IF simgauss%=1
  1090.       prol=0
  1091.       GOSUB zeichnung
  1092.       GOTO huellend
  1093.     ENDIF
  1094.     GOSUB gauss_lorentz
  1095.   ENDIF
  1096.   IF kurve%=2
  1097.     IF simlorentz%=1
  1098.       prol=1
  1099.       GOSUB zeichnung
  1100.       GOTO huellend
  1101.     ENDIF
  1102.     GOSUB gauss_lorentz
  1103.   ENDIF
  1104.   IF kurve%=3
  1105.     IF simgauss_lorentz%=1
  1106.       ALERT 2," | NEUE KURVE BERECHNEN ? ",2," NEIN | JA ",butt%
  1107.       IF butt%=1
  1108.         prol=proz
  1109.         GOSUB zeichnung
  1110.         GOTO huellend
  1111.       ENDIF
  1112.     ENDIF
  1113.     IF simgauss%=0
  1114.       GOSUB gauss_lorentz
  1115.     ENDIF
  1116.     CLS
  1117.     IF f_ormstupid!=TRUE
  1118.       GOTO stupidlorentz
  1119.     ENDIF
  1120.     DEFTEXT 1,0,0,13
  1121.     PRINT AT(30,12);
  1122.     INPUT "% Lorentz: ",prol
  1123.     stupidlorentz:
  1124.     prol=prol/100
  1125.     proz=prol
  1126.     prog=1-prol
  1127.     l%=0
  1128.     DO
  1129.       huelk%(2,l%)=huelk%(0,l%)*prog+huelk%(1,l%)*prol
  1130.       huelk%(2,bi%-l%)=-huelk%(2,l%)
  1131.       INC l%
  1132.       EXIT IF l%>spekha%
  1133.     LOOP
  1134.     simgauss_lorentz%=1
  1135.     GOSUB zeichnung
  1136.     GOTO huellend
  1137.   ENDIF
  1138.   '
  1139.   GOSUB zeichnung
  1140.   huellend:
  1141. RETURN
  1142. '
  1143. '
  1144. PROCEDURE gauss_lorentz            ! Berechnung der Hüllkurve
  1145.   LOCAL l%,m,max%,start%,sta,beenden%,p,bo,di,qdi,wure,bereich
  1146.   LOCAL wert,n%,maxgau%,maxlor%,normbereich,feldanfang,mg,ml
  1147.   LOCAL feld
  1148.   gpp=sw/auf
  1149.   wure=SQR(EXP(1))
  1150.   normbereich=halbwert*20
  1151.   bereich=hy(b)-hy(1)+normbereich
  1152.   spekha%=bi%/2
  1153.   IF bereich>sw
  1154.     feldanf=centerfield-bereich/2
  1155.   ELSE
  1156.     feldanf=centerfield-sw/2
  1157.   ENDIF
  1158.   l%=0
  1159.   m=0
  1160.   max%=INT(normbereich*ppg)
  1161.   CLS
  1162.   DEFTEXT 1,0,0,13
  1163.   PRINT AT(10,15);"Nur Geduld, Rom wurde auch nicht an einem"
  1164.   PRINT AT(10,17);"Tag erbaut.................."
  1165.   DO
  1166.     INC m
  1167.     sta=(hy(m)-feldanf-normbereich/2)*ppg
  1168.     start%=INT(sta)
  1169.     beenden%=start%+max%
  1170.     IF start%<l% OR start%=l%
  1171.       start%=l%
  1172.     ENDIF
  1173.     IF beenden%>spekha%
  1174.       beenden%=spekha%
  1175.     ENDIF
  1176.     IF start%<spekha%
  1177.       FOR l%=start% TO beenden%
  1178.         p=m
  1179.         feld=feldanf+gpp*l%
  1180.         schleife:
  1181.         h%=FIX(hy(p)*ppg+0.5)
  1182.         bo=h%*gpp
  1183.         di=(feld-bo)/halbwert
  1184.         qdi=di*di
  1185.         qa=(1+4*qdi/3)^2
  1186.         wert=wure*di*EXP(-2*qdi)
  1187.         einh(0,l%)=einh(0,l%)+wert*intensi(p)
  1188.         einh(1,l%)=einh(1,l%)+16/9*di/qa*intensi(p)
  1189.         IF p<b
  1190.           INC p
  1191.           IF (hy(p)-halbwert*10)<=feld
  1192.             GOTO schleife
  1193.           ENDIF
  1194.         ENDIF
  1195.         p=m
  1196.         links:
  1197.         IF p>=2
  1198.           DEC p
  1199.           IF (hy(p)+halbwert*10)>=feld
  1200.             h%=FIX(hy(p)*ppg+0.5)
  1201.             bo=h%*gpp
  1202.             di=(feld-bo)/halbwert
  1203.             qdi=di*di
  1204.             qa=(1+4*qdi/3)^2
  1205.             wert=wure*di*EXP(-2*qdi)
  1206.             einh(0,l%)=einh(0,l%)+wert*intensi(p)
  1207.             einh(1,l%)=einh(1,l%)+16/9*di/qa*intensi(p)
  1208.           ENDIF
  1209.           GOTO links
  1210.         ENDIF
  1211.       NEXT l%
  1212.     ELSE
  1213.       l%=start%
  1214.     ENDIF
  1215.     EXIT IF l%>=spekha%
  1216.   LOOP
  1217.   PRINT AT(20,20);"...aber an einem Tag abgebrannt!"
  1218.   l%=0
  1219.   DIM huelk%(2,bi%)
  1220.   DO
  1221.     huelk%(0,l%)=CINT(einh(0,l%)*1000000)
  1222.     IF ABS(huelk%(0,l%))>maxgau%
  1223.       maxgau%=ABS(huelk%(0,l%))
  1224.     ENDIF
  1225.     huelk%(1,l%)=CINT(einh(1,l%)*1000000)
  1226.     IF ABS(huelk%(1,l%))>maxlor%
  1227.       maxlor%=ABS(huelk%(1,l%))
  1228.     ENDIF
  1229.     INC l%
  1230.     EXIT IF l%>spekha%
  1231.   LOOP
  1232.   mg=1000000/maxgau%
  1233.   ml=1000000/maxlor%
  1234.   l%=0
  1235.   DO
  1236.     huelk%(0,l%)=CINT(huelk%(0,l%)*mg)
  1237.     huelk%(0,bi%-l%)=-huelk%(0,l%)
  1238.     huelk%(1,l%)=CINT(huelk%(1,l%)*ml)
  1239.     huelk%(1,bi%-l%)=-huelk%(1,l%)
  1240.     INC l%
  1241.     EXIT IF l%>spekha%
  1242.   LOOP
  1243.   huelk%(0,spekha%)=0
  1244.   huelk%(1,spekha%)=0
  1245.   ERASE einh()
  1246.   simgauss%=1
  1247.   simlorentz%=1
  1248. RETURN
  1249. '
  1250. PROCEDURE zeichnung                    ! Zeichnen der Hüllkurve
  1251.   MENU OFF
  1252.   CLS
  1253.   simess!=0
  1254.   halb!=0
  1255.   DEFLINE 1,1
  1256.   LOCAL fa,anf
  1257.   IF ver=0
  1258.     ver=1
  1259.   ENDIF
  1260.   IF sweep=0
  1261.     sweep=sw
  1262.   ENDIF
  1263.   amb=ROUND(0,2)
  1264.   mb=ROUND(sweep,2)
  1265.   BOX 27,60,613,360
  1266.   DEFLINE 1,1,0,0
  1267.   LINE 27,360,27,365
  1268.   LINE 321,360,321,365
  1269.   LINE 613,360,613,365
  1270.   DEFTEXT 1,0,0,6
  1271.   PRINT AT(3,2);"Filename: ";finame$;
  1272.   PRINT AT(40,2);"Auflösung: ";auf;
  1273.   PRINT AT(3,5);"Simulierte Sweep Width :";sw;
  1274.   PRINT AT(40,5);"Halbwertsbreite: ";halbwert
  1275.   PRINT AT(60,2);" % Lorentz: ";prol*100;
  1276.   PRINT AT(3,80);amb;
  1277.   PRINT AT(40,80);mb*0.5;
  1278.   PRINT AT(75,80);mb;
  1279.   fa=586/sweep
  1280.   IF sweep>=simsw
  1281.     fak=fa*simsw/bi%
  1282.     start%=CINT((sweep-simsw)/2*fa+27)
  1283.     anfang%=0
  1284.     ende%=bi%
  1285.   ELSE
  1286.     anf=sweep/2*ppg+0.5
  1287.     anfang%=spekha%-CINT(anf)
  1288.     ende%=spekha%+CINT(anf)
  1289.     fak=586/(ende%-anfang%)
  1290.     start%=27
  1291.   ENDIF
  1292.   GOSUB pinsel
  1293.   MENU 27,3
  1294.   MENU 28,3
  1295.   spektrum!=FALSE
  1296.   huell!=TRUE
  1297.   MENU 35,3
  1298.   MENU 36,3
  1299.   MENU 37,3
  1300.   MENU 31,3
  1301.   MENU 38,3
  1302.   IF mess!=-1
  1303.     MENU 44,3
  1304.   ENDIF
  1305.   bereichsplott!=FALSE
  1306.   simm!=-1
  1307.   messplo!=0
  1308.   zeichnungende:
  1309.   HIDEM
  1310.   SGET x1$
  1311.   SHOWM
  1312.   DEFLINE 1,1,0,0
  1313. RETURN
  1314. '
  1315. '
  1316. '
  1317. ' *********VERGRÖßEREUNG D.H. AUSSCHNITT *******************
  1318. '
  1319. PROCEDURE bereich
  1320.   MENU OFF
  1321.   LOCAL maus%,key$,x1,x2,g1,g2,gaus1,gaus2,bereich%,li%,re%,lix,rex
  1322.   LOCAL l%
  1323.   CLS
  1324.   simess!=0
  1325.   halb!=0
  1326.   DEFLINE 1,1,0,0
  1327.   IF bereichsplott!=FALSE
  1328.     bereichshalbe%=spekha%
  1329.     sweepbereich=sweep
  1330.     GOSUB zeichnung
  1331.     g1=0
  1332.     g2=0
  1333.   ELSE
  1334.     GOSUB pinsel
  1335.     BOX 27,60,613,360
  1336.     LINE 27,360,27,365
  1337.     LINE 321,360,321,365
  1338.     LINE 613,360,613,365
  1339.     DEFTEXT 1,0,0,6
  1340.     PRINT AT(3,2);"Filename: ";finame$;
  1341.     PRINT AT(40,2);"Auflösung: ";auf;
  1342.     PRINT AT(3,5);"Simulierte Sweep Width :";sw;
  1343.     PRINT AT(40,5);"Halbwertsbreite: ";halbwert;
  1344.     PRINT AT(60,2);" % Lorentz: ";prol*100;
  1345.     PRINT AT(3,80);amb;
  1346.     PRINT AT(35,80);ROUND(mb-amb,2);" GAUSS ";
  1347.     PRINT AT(74,80);mb;
  1348.     HIDEM
  1349.     SGET x1$
  1350.     SHOWM
  1351.   ENDIF
  1352.   g1=amb
  1353.   g2=mb
  1354.   bereichanfang:
  1355.   p_line!=FALSE
  1356.   SPUT x1$
  1357.   BOX 580,35,613,55
  1358.   DEFTEXT 1,1,0,13
  1359.   TEXT 583,50,25,"ESC"
  1360.   DEFTEXT 1,1,0,6
  1361.   DO
  1362.     key$=INKEY$
  1363.     IF key$=CHR$(27)
  1364.       maus%=3
  1365.     ENDIF
  1366.     IF key$=CHR$(127)
  1367.       maus%=2
  1368.     ENDIF
  1369.     IF MOUSEK>0
  1370.       maus%=1
  1371.     ENDIF
  1372.     IF MOUSEX>580 AND MOUSEY>35
  1373.       IF MOUSEX<613 AND MOUSEY<55 AND MOUSEK>0
  1374.         maus%=3
  1375.       ENDIF
  1376.     ENDIF
  1377.     EXIT IF maus%>0
  1378.     key$=""
  1379.   LOOP
  1380.   IF maus%=3
  1381.     GOTO bereichende
  1382.   ENDIF
  1383.   IF maus%=2
  1384.     bereichshalbe%=spekha%
  1385.     sweepbereich=sweep
  1386.     CLS
  1387.     GOSUB zeichnung
  1388.     g1=0
  1389.     g2=0
  1390.   ENDIF
  1391.   HIDEM
  1392.   SGET x1$
  1393.   SHOWM
  1394.   DEFLINE 2,1,1,1
  1395.   SETMOUSE 321,200,0
  1396.   icks1:
  1397.   DO                      !Abfrage der linken Grenze
  1398.     SPUT x1$
  1399.     x1=MOUSEX
  1400.     li%=MOUSEX-27
  1401.     IF li%<0
  1402.       li%=0
  1403.     ENDIF
  1404.     IF li%>586
  1405.       li%=586
  1406.     ENDIF
  1407.     lix=ROUND(((mb-amb)/586*li%)+amb,2)
  1408.     PRINT AT(4,7);lix
  1409.     COLOR 1
  1410.     LINE x1,60,x1,360
  1411.     PAUSE 5
  1412.     IF MOUSEK=1
  1413.       COLOR 1
  1414.       LINE x1,60,x1,360
  1415.       lin=1
  1416.       HIDEM
  1417.       SGET x1$
  1418.       SHOWM
  1419.     ENDIF
  1420.     EXIT IF lin=1
  1421.   LOOP
  1422.   IF x1<27 OR x1>613
  1423.     GOTO icks1
  1424.   ENDIF
  1425.   icks2:
  1426.   maus%=0
  1427.   DO                     !Abfrage der rechten Grenze
  1428.     SPUT x1$
  1429.     x2=MOUSEX
  1430.     re%=MOUSEX-27
  1431.     IF re%<0
  1432.       re%=0
  1433.     ENDIF
  1434.     IF re%>586
  1435.       re%=586
  1436.     ENDIF
  1437.     rex=ROUND(((mb-amb)/586*re%)+amb,2)
  1438.     PRINT AT(14,7);rex;
  1439.     PRINT AT(24,7);ROUND(rex-lix,2);
  1440.     COLOR 1
  1441.     LINE x2,60,x2,360
  1442.     PAUSE 5
  1443.     COLOR 1
  1444.     IF MOUSEK=2
  1445.       LINE x2,60,x2,360
  1446.       lin=2
  1447.     ENDIF
  1448.     EXIT IF lin=2
  1449.   LOOP
  1450.   IF x1=x2
  1451.     GOTO icks2
  1452.   ENDIF
  1453.   IF x2<x1 OR x2>614
  1454.     GOTO icks2
  1455.   ENDIF
  1456.   '
  1457.   gaus1=((x1-27)*sweepbereich/586)
  1458.   gaus2=((x2-27)*sweepbereich/586)
  1459.   '
  1460.   la%=CINT(bereichshalbe%-(sweepbereich/2-gaus1)*ppg)
  1461.   le%=CINT(bereichshalbe%-(sweepbereich/2-gaus2)*ppg)
  1462.   bereich%=le%-la%
  1463.   fak=586/bereich%
  1464.   bereichshalbe%=bereich%/2+la%
  1465.   sweepbereich=gaus2-gaus1
  1466.   g1=gaus1+g1
  1467.   g2=g1+sweepbereich
  1468.   halbe=(g2-g1)*0.5+g1
  1469.   mb=ROUND(g2,2)
  1470.   amb=ROUND(g1,2)
  1471.   fhalbe=ROUND(halbe,2)
  1472.   '
  1473.   CLS
  1474.   DEFLINE 1,1,0,0
  1475.   BOX 27,60,613,360
  1476.   LINE 27,360,27,365
  1477.   LINE 321,360,321,365
  1478.   LINE 613,360,613,365
  1479.   DEFTEXT 1,0,0,6
  1480.   PRINT AT(3,2);"Filename: ";finame$;
  1481.   PRINT AT(40,2);"Auflösung: ";auf;
  1482.   PRINT AT(3,5);"Simulierte Sweep Width :";sw;
  1483.   PRINT AT(40,5);"Halbwertsbreite: ";halbwert;
  1484.   PRINT AT(60,2);" % Lorentz: ";prol*100;
  1485.   PRINT AT(3,80);amb;
  1486.   PRINT AT(35,80);ROUND(mb-amb,2);" GAUSS";
  1487.   PRINT AT(74,80);mb;
  1488.   '
  1489.   IF la%>bi%
  1490.     p_line!=-1
  1491.   ENDIF
  1492.   IF la%<0 OR la%=0
  1493.     anfang%=0
  1494.     start%=CINT(ABS(la%*fak)+27)
  1495.   ENDIF
  1496.   IF la%>0
  1497.     anfang%=la%
  1498.     start%=27
  1499.   ENDIF
  1500.   IF le%<0 OR le%=0
  1501.     p_line!=TRUE
  1502.   ELSE
  1503.     IF le%>bi%
  1504.       ende%=bi%
  1505.     ELSE
  1506.       ende%=le%
  1507.     ENDIF
  1508.   ENDIF
  1509.   '
  1510.   GOSUB pinsel
  1511.   HIDEM
  1512.   SGET x1$
  1513.   SHOWM
  1514.   GOTO bereichanfang
  1515.   '
  1516.   bereichende:
  1517.   DEFFILL 0,0
  1518.   PBOX 579,34,614,56
  1519.   SGET x1$
  1520.   huell!=FALSE
  1521.   bereichsplott!=TRUE
  1522.   messplo!=0
  1523.   DEFLINE 1,1,0,0
  1524. RETURN
  1525. '
  1526. PROCEDURE pinsel
  1527.   hoehe=150/1000000
  1528.   IF simess!=-1
  1529.     DEFLINE defl%,1,0,0
  1530.   ELSE
  1531.     DEFLINE 1,1,0,0
  1532.   ENDIF
  1533.   IF p_line!=-1
  1534.     LINE 27,210+offset%,613,210+offset%
  1535.     gerade!=-1
  1536.   ELSE
  1537.     gerade!=0
  1538.     DRAW 27,210+offset%
  1539.     DRAW  TO start%,210+offset%
  1540.     '
  1541.     FOR l%=anfang% TO ende%
  1542.       x%=(l%-anfang%)*fak+start%
  1543.       y%=210+offset%+huelk%(kurve%-1,l%)*hoehe*ver
  1544.       IF halb!=-1
  1545.         IF y%<210
  1546.           y%=210
  1547.         ENDIF
  1548.       ENDIF
  1549.       IF y%>360
  1550.         y%=360
  1551.       ENDIF
  1552.       IF y%<60
  1553.         y%=60
  1554.       ENDIF
  1555.       DRAW  TO x%,y%
  1556.     NEXT l%
  1557.     DRAW  TO 613,210+offset%
  1558.   ENDIF
  1559.   DEFLINE 1,1,0,0
  1560.   IF simess!=-1
  1561.     HIDEM
  1562.     SGET x1$
  1563.     SHOWM
  1564.   ENDIF
  1565. RETURN
  1566. ' **************EIN-UND AUSGABE ÜBER DISKETTE *************
  1567. PROCEDURE lese          ! Daten Einlesen
  1568.   MENU OFF
  1569.   '
  1570.   LOCAL wahl$,bakl%,l$
  1571.   l$=CHR$(GEMDOS(25)+65)
  1572.   FILESELECT l$+":\DATEN\*.*","",wahl$
  1573.   IF wahl$=""
  1574.     GOTO leseende
  1575.   ENDIF
  1576.   IF EXIST(wahl$)
  1577.     ERASE ag()
  1578.     ERASE ag1()
  1579.     ERASE hy()
  1580.     ERASE at$()
  1581.     ERASE intensi()
  1582.     ERASE huelk%()
  1583.     DEFTEXT 1,17,0,17
  1584.     TEXT 150,150,300,"BIN BEIM LESEN "
  1585.     VOID FRE(0)           ! Wegen der Müllabfuhr!
  1586.     OPEN "I",#1,wahl$
  1587.     WHILE NOT EOF(#1)
  1588.       INPUT #1,nika%
  1589.       INPUT #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
  1590.       INPUT #1,b,sweep,intmin,intmax,centerfield
  1591.       DIM ag(nika%,2),ag1(nika%,2),at$(nika%,2)
  1592.       DIM hy(b)
  1593.       DIM intensi(b)
  1594.       BGET #1,VARPTR(ag(0,0)),DIM?(ag())*8
  1595.       BGET #1,VARPTR(hy(0)),DIM?(hy())*8
  1596.       BGET #1,VARPTR(intensi(0)),DIM?(intensi())*8
  1597.       '
  1598.       INPUT #1,simgauss%,simlorentz%,simgauss_lorentz%,bi%,simstick%,spekha%,proz
  1599.       INPUT #1,simsw
  1600.       DIM huelk%(2,bi%)
  1601.       BGET #1,VARPTR(huelk%(0,0)),DIM?(huelk%())*4
  1602.     WEND
  1603.     CLOSE
  1604.     MENU 17,3
  1605.     MENU 22,3
  1606.     MENU 23,3
  1607.     ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1608.     bakl%=RINSTR(wahl$,"\")
  1609.     finame$=MID$(wahl$,bakl%+1)
  1610.     ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1611.     '
  1612.     GOTO leseende
  1613.   ENDIF
  1614.   ALERT 1," DATEI IST NICHT | |  VORHANDEN !",1," KLAR ? ",but%
  1615.   '
  1616.   leseende:
  1617.   CLS
  1618.   '
  1619. RETURN
  1620. '
  1621. PROCEDURE schreibe                   ! Daten auf Disk. schreiben
  1622.   MENU OFF
  1623.   '
  1624.   LOCAL wahl$,l$
  1625.   IF simkurve%=0
  1626.     IF simstick%=0
  1627.       GOTO schreibende
  1628.     ENDIF
  1629.   ENDIF
  1630.   l$=CHR$(GEMDOS(25)+65)
  1631.   FILESELECT l$+":\DATEN\*.*",finame$,wahl$
  1632.   IF wahl$=""
  1633.     GOTO schreibende
  1634.   ENDIF
  1635.   IF EXIST(wahl$)
  1636.     ALERT 1," DATEI EXISTIERT SCHON ! | ACHTUNG ! | DIE DATEI WIRD ÜBERSCHRIEBEN !",1," ABBRUCH | WEITER ",buton%
  1637.     IF buton%=1
  1638.       GOTO schreibende
  1639.     ENDIF
  1640.   ENDIF
  1641.   DEFTEXT 1,17,0,17
  1642.   TEXT 150,150,300,"BIN BEIM SCHREIBEN "
  1643.   VOID FRE(0)                ! wegen der Müllabfuhr !
  1644.   OPEN "O",#1,wahl$
  1645.   WRITE #1,nika%
  1646.   WRITE #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
  1647.   WRITE #1,b,sweep,intmin,intmax,centerfield
  1648.   BPUT #1,VARPTR(ag(0,0)),DIM?(ag())*8
  1649.   BPUT #1,VARPTR(hy(0)),DIM?(hy())*8
  1650.   BPUT #1,VARPTR(intensi(0)),DIM?(intensi())*8
  1651.   '
  1652.   WRITE #1,simgauss%,simlorentz%,simgauss_lorentz%,bi%,simstick%,spekha%,proz
  1653.   WRITE #1,simsw
  1654.   BPUT #1,VARPTR(huelk%(0,0)),DIM?(huelk%())*4
  1655.   CLOSE
  1656.   '
  1657.   schreibende:
  1658.   CLS
  1659. RETURN
  1660. '
  1661. PROCEDURE loesche                    ! Der Name sagt alles
  1662.   LOCAL wahl$,l$,button%,but%
  1663.   MENU OFF
  1664.   l$=CHR$(GEMDOS(25)+65)
  1665.   FILESELECT l$+":\DATEN\*.*","",wahl$
  1666.   IF wahl$=""
  1667.     GOTO loeschende
  1668.   ENDIF
  1669.   DEFTEXT 1,0,0,13
  1670.   IF EXIST(wahl$)
  1671.     ALERT 3," SOLL DIE DATEI | | | WIRKLICH GELÖSCHT WERDEN? ",1," NEIN | JA ",button%
  1672.     IF button%=2
  1673.       KILL wahl$
  1674.     ENDIF
  1675.     GOTO loeschende
  1676.   ENDIF
  1677.   ALERT 1," DATEI IST NICHT | |  VORHANDEN !",1," KLAR ? ",but%
  1678.   loeschende:
  1679. RETURN
  1680. '
  1681. ' *************************************************************************
  1682. PROCEDURE namensgebung                ! Filename
  1683.   MENU OFF
  1684.   DEFTEXT 1,0,0,13
  1685.   BOX 180,175,380,200
  1686.   PRINT AT(25,12);"Filename: ________.___"
  1687.   PRINT AT(35,12);
  1688.   FORM INPUT 12 AS finame$
  1689. RETURN
  1690. '
  1691. '
  1692. PROCEDURE fehlerbehandlung      ! Versuch um Fehler abzufangen
  1693.   CLS
  1694.   LOCAL bott%,bottom%,butt%,fehler$
  1695.   DEFTEXT 1,1,0,13
  1696.   fehler$=STR$(ERR)
  1697.   IF ERR<101
  1698.     IF ERR=37
  1699.       CLOSE
  1700.       IF f_ormstupid!=TRUE
  1701.         ALERT 1," Disk hat zuwenig Speicher ! | Also  nochmal Eintippen! | (Ich hab ja gewarnt!!) | Aber erstmal weiter!",1," TJAAA.. ",bott%
  1702.         IF bott%=1
  1703.           RESUME rettung
  1704.         ENDIF
  1705.       ELSE
  1706.         ALERT 1," Diskette hat zu- | wenig Speicherplatz! ",1," KO? ",bottom%
  1707.         IF bottom%=1
  1708.           RESUME neustart
  1709.         ENDIF
  1710.       ENDIF
  1711.     ENDIF
  1712.     IF ERR=22
  1713.       CLOSE
  1714.       RESUME neustart
  1715.     ENDIF
  1716.     ALERT 2," ÄCHZ! FEHLER "+fehler$+" | IST AUFGETRETEN | NOCH MAL PROBIEREN ? ",1," JA ! | LMAA ! ",butt%
  1717.     IF butt%=1
  1718.       RESUME neustart
  1719.     ELSE
  1720.       CLS
  1721.       DEFTEXT 1,16,0,26
  1722.       PRINT AT(10,20);" NA GOTT SEI DANK !"
  1723.       END
  1724.     ENDIF
  1725.   ENDIF
  1726. RETURN
  1727. '
  1728. '
  1729. '
  1730. PROCEDURE robot                 ! Sogenannte Autosimulationsroutine
  1731.   LOCAL maus%,s_stop%,korr%
  1732.   MENU OFF
  1733.   DEFTEXT 1,0,0,13
  1734.   IF rettung!=-1
  1735.     GOTO sichern
  1736.   ENDIF
  1737.   ' **********************************************************************************
  1738.   GOSUB datenordner
  1739.   ' *****************************************************************************`
  1740.   diskfrei%=DFREE(0)
  1741.   ' ****************************  WIRD AUSDRUCK GEWÜNSCHT ? ***********
  1742.   ALERT 2," | MIT GLEICHZEITIGEM | AUSDRUCK ? ",1," KLARO | NEEE ",dr%
  1743.   IF dr%=1
  1744.     druck!=TRUE
  1745.     ALERT 2," | AUSDRUCK MIT | PARAMETER ? ",1," NA KLAR | QUATSCH ",par%
  1746.     IF par%=1
  1747.       daten!=TRUE
  1748.     ELSE
  1749.       daten!=FALSE
  1750.     ENDIF
  1751.   ELSE
  1752.     druck!=FALSE
  1753.   ENDIF
  1754.   ALERT 2," | MIT GLEICHZEITIGEM | ABSPEICHERN DER | SPEKTREN ? ",2," SICHER | UNSINN",speicher%
  1755.   ' ********************************************************************
  1756.   IF finame$=""
  1757.     finame$="Unfug"
  1758.   ENDIF
  1759.   DEFTEXT 1,0,0,13
  1760.   BOX 180,175,380,200
  1761.   PRINT AT(25,12);"Filename: ______"
  1762.   PRINT AT(35,12);
  1763.   FORM INPUT 6 AS finame$
  1764.   zaehl$=finame$
  1765.   CLS
  1766.   f_ormstupid!=TRUE
  1767.   simu_eingabe:
  1768.   laufwerk%=GEMDOS(25)
  1769.   IF BIOS(&H9,laufwerk%)>0
  1770.     CHDIR "\"
  1771.     IF 0<>FSFIRST("daten",-1)  !Ist Ordner Daten vorhanden?
  1772.       MKDIR "DATEN"
  1773.     ENDIF
  1774.     diskfrei%=DFREE(0)
  1775.     CHDIR "DATEN"
  1776.   ENDIF
  1777.   DEFTEXT 1,8,0,18
  1778.   PRINT AT(10,5);
  1779.   INPUT " Anzahl der simulationen:";simu%
  1780.   CLS
  1781.   IF speicher%=1
  1782.     DEFTEXT 1,1,0,13
  1783.     IF diskfrei%<simu%*50000
  1784.       PRINT AT(10,5);"Achtung die Diskette hat nur ";diskfrei%;" Bytes Speicherplatz !";
  1785.       PRINT AT(10,8);"             Das könnte knapp werden !!!! ";
  1786.       PRINT AT(10,11);"Besser ist es eine neue Diskette zu verwenden oder die ";
  1787.       PRINT AT(10,14);"     Zahl der Simulationen entsprechend zu verringern";
  1788.       BOX 100,320,200,360
  1789.       BOX 450,320,550,360
  1790.       TEXT 120,340,"NA KLAR"
  1791.       TEXT 470,340,"Risiko"
  1792.       maus%=0
  1793.       DO
  1794.         IF MOUSEY>320 AND MOUSEY<360
  1795.           IF MOUSEX>100 AND MOUSEX<200 AND MOUSEK=1
  1796.             maus%=1
  1797.           ENDIF
  1798.           IF MOUSEX>450 AND MOUSEX<550 AND MOUSEK=1
  1799.             maus%=2
  1800.           ENDIF
  1801.         ENDIF
  1802.         EXIT IF maus%>0
  1803.       LOOP
  1804.       IF maus%=1
  1805.         CLS
  1806.         GOTO simu_eingabe
  1807.       ENDIF
  1808.       IF maus%=2
  1809.         CLS
  1810.         TEXT 250,50,"Eigenes Risiko!"
  1811.       ENDIF
  1812.     ENDIF
  1813.   ENDIF
  1814.   '
  1815.   '
  1816.   IF speicher%=2
  1817.     DEFTEXT 1,1,0,13
  1818.     IF diskfrei%<simu%*1024
  1819.       PRINT AT(10,5);"Achtung die Diskette hat nur ";diskfrei%;" Bytes Speicherplatz !";
  1820.       PRINT AT(10,8);"             Das wird nicht reichen  !!!! ";
  1821.       PRINT AT(10,11);"Besser ist es eine neue Diskette zu verwenden oder die ";
  1822.       PRINT AT(10,14);"     Zahl der Simulationen entsprechend zu verringern";
  1823.       BOX 100,320,200,360
  1824.       BOX 450,320,550,360
  1825.       TEXT 120,340,"NA KLAR"
  1826.       TEXT 470,340,"Risiko"
  1827.       maus%=0
  1828.       DO
  1829.         IF MOUSEY>320 AND MOUSEY<360
  1830.           IF MOUSEX>100 AND MOUSEX<200 AND MOUSEK=1
  1831.             maus%=1
  1832.           ENDIF
  1833.           IF MOUSEX>450 AND MOUSEX<550 AND MOUSEK=1
  1834.             maus%=2
  1835.           ENDIF
  1836.         ENDIF
  1837.         EXIT IF maus%>0
  1838.       LOOP
  1839.       IF maus%=1
  1840.         CLS
  1841.         GOTO simu_eingabe
  1842.       ENDIF
  1843.       IF maus%=2
  1844.         CLS
  1845.         TEXT 200,50,200,"NICHT ZU VIEL RISIKO!"
  1846.         PAUSE 60
  1847.         GOTO simu_eingabe
  1848.       ENDIF
  1849.     ENDIF
  1850.   ENDIF
  1851.   '
  1852.   '
  1853.   '
  1854.   '
  1855.   IF simu%=0
  1856.     GOTO robotende
  1857.   ENDIF
  1858.   ERASE quark$()
  1859.   ERASE auswahl$()
  1860.   IF simstick%=1 OR simgaus%=1
  1861.     ERASE hy()
  1862.     ERASE intensi()
  1863.     ERASE huelk%()
  1864.   ENDIF
  1865.   DIM quark$(simu%),auswahl$(simu%)
  1866.   FOR simulat%=1 TO simu%
  1867.     quark$(simulat%)="init"+STR$(simulat%)
  1868.     '
  1869.     korrektur:
  1870.     '
  1871.     DEFTEXT 1,0,0,13
  1872.     PRINT AT(15,5);" DATENSATZ NUMMER : ";simulat%;" - VON - ";simu%;" - SIMULATIONEN";
  1873.     '
  1874.     GOSUB atom
  1875.     '
  1876.     GOSUB eingabe
  1877.     '
  1878.     IF simulat%=1
  1879.       auf=1024
  1880.       auf1=1024
  1881.       sw=50
  1882.       sw1=50
  1883.       halbwert=0.2
  1884.       halbwertsbreite=0.2
  1885.     ENDIF
  1886.     '
  1887.     GOSUB spektrenparameter
  1888.     '
  1889.     CLS
  1890.     DEFTEXT 1,8,0,18
  1891.     PRINT AT(14,5);"Auswahl der Hüllkurvenform";
  1892.     TEXT 120,180,"GAUß"
  1893.     TEXT 240,180,"LORENTZ"
  1894.     TEXT 350,180,"GAUß/LORENTZ"
  1895.     BOX 100,150,500,200
  1896.     kurve%=0
  1897.     DO
  1898.       IF MOUSEY>150 AND MOUSEY<200
  1899.         IF MOUSEX<180 AND MOUSEX>100 AND MOUSEK=1
  1900.           kurve%=1
  1901.           prol=0
  1902.         ENDIF
  1903.         IF MOUSEX<320 AND MOUSEX>230 AND MOUSEK=1
  1904.           kurve%=2
  1905.           prol=1
  1906.         ENDIF
  1907.         IF MOUSEX<500 AND MOUSEX>350 AND MOUSEK=1
  1908.           kurve%=3
  1909.         ENDIF
  1910.       ENDIF
  1911.       EXIT IF kurve%>0
  1912.     LOOP
  1913.     CLS
  1914.     IF kurve%=3
  1915.       CLS
  1916.       PRINT AT(17,5);" Gauß-Lorentz-Kurve";
  1917.       PRINT AT(17,8);" Eingabe in Prozent";
  1918.       PRINT AT(20,11);
  1919.       INPUT "% Lorentz= ";prol
  1920.       IF prol>100
  1921.         prol=100
  1922.       ENDIF
  1923.       IF prol<0
  1924.         prol=0
  1925.       ENDIF
  1926.     ENDIF
  1927.     CLS
  1928.     '
  1929.     ALERT 2," | |  EINGABE IN ORDNUNG ? ",1," SICHER | ÄÄHH | ABBRUCH ",korr%
  1930.     IF korr%=2
  1931.       GOTO korrektur
  1932.     ENDIF
  1933.     IF korr%=3
  1934.       ALERT 2," | WIRKLICH DIE AUTO- | SIMULATION BEENDEN ? ",1," NEIN | JA DOCH ",abb%
  1935.       IF abb%=2
  1936.         s_top%=simulat%-1
  1937.         simulat%=simu%
  1938.         simu%=s_top%
  1939.         GOTO abbruch
  1940.       ENDIF
  1941.     ENDIF
  1942.     '
  1943.     OPEN "O",#1,quark$(simulat%)
  1944.     WRITE #1,nika%
  1945.     WRITE #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
  1946.     FOR j%=1 TO nika%
  1947.       WRITE #1,ag(j%,0),ag(j%,1),ag(j%,2)
  1948.     NEXT j%
  1949.     WRITE #1,kurve%,prol
  1950.     CLOSE
  1951.     abbruch:
  1952.   NEXT simulat%
  1953.   IF simu%=0
  1954.     GOTO robotende
  1955.   ENDIF
  1956.   '
  1957.   sichern:
  1958.   FOR simulat%=1 TO simu%
  1959.     IF rettung!=-1
  1960.       GOTO rettungs_schrieb
  1961.     ENDIF
  1962.     ERASE ag()
  1963.     ERASE ag1()
  1964.     ERASE at$()
  1965.     datei!=EXIST(quark$(simulat%))
  1966.     IF datei!=FALSE
  1967.       CHDIR "\"
  1968.     ENDIF
  1969.     datei!=EXIST(quark$(simulat%))
  1970.     IF datei!=FALSE
  1971.       CHDIR "\DATEN"
  1972.     ENDIF
  1973.     IF EXIST(quark$(simulat%))=FALSE
  1974.       PRINT "VERDAMMTE SCHEIßE"
  1975.       END
  1976.     ENDIF
  1977.     OPEN "I",#1,quark$(simulat%)
  1978.     WHILE NOT EOF(#1)
  1979.       INPUT #1,nika%
  1980.       INPUT #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
  1981.       DIM ag(nika%,2),ag1(nika%,2),at$(nika%,2)
  1982.       FOR j%=1 TO nika%
  1983.         INPUT #1,ag(j%,0),ag(j%,1),ag(j%,2)
  1984.       NEXT j%
  1985.       INPUT #1,kurve%,prol
  1986.     WEND
  1987.     CLOSE
  1988.     '
  1989.     auswahl$(simulat%)=zaehl$+STR$(simulat%)
  1990.     finame$=auswahl$(simulat%)
  1991.     '
  1992.     GOSUB hyper
  1993.     '
  1994.     GOSUB linienform
  1995.     '
  1996.     rettungs_schrieb:
  1997.     IF speicher%=1
  1998.       VOID FRE(0)
  1999.       OPEN "O",#1,auswahl$(simulat%)
  2000.       WRITE #1,nika%
  2001.       WRITE #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
  2002.       WRITE #1,b,sweep,intmin,intmax,centerfield
  2003.       BPUT #1,VARPTR(ag(0,0)),DIM?(ag())*8
  2004.       BPUT #1,VARPTR(hy(0)),DIM?(hy())*8
  2005.       BPUT #1,VARPTR(intensi(0)),DIM?(intensi())*8
  2006.       WRITE #1,simgauss%,simlorentz%,simgauss_lorentz%,bi%,simstick%,spekha%,proz
  2007.       WRITE #1,simsw
  2008.       BPUT #1,VARPTR(huelk%(0,0)),DIM?(huelk%())*4
  2009.       CLOSE
  2010.     ENDIF
  2011.     IF EXIST(quark$(simulat%))
  2012.       KILL quark$(simulat%)
  2013.     ENDIF
  2014.     '
  2015.     IF druck!=TRUE                    ! ABFRAGE OB AUSDRUCK GEWÜNSCHT WIRD
  2016.       IF OUT?(0)=FALSE                ! IST DRUCKER EINGESCHALTET ?
  2017.         ALERT 3," DRUCKER IST NICHT | EINGESCHALTET ! | EINSCHALTEN ODER OHNE | AUSDRUCK LEBEN ",1," IST EIN | OHNE ",frag%
  2018.         IF frag%=2
  2019.           druck!=FALSE
  2020.           GOTO druck_ende
  2021.         ENDIF
  2022.       ENDIF
  2023.       IF daten!=TRUE
  2024.         GOSUB datendruck
  2025.       ENDIF
  2026.       GOSUB hardcopy
  2027.       druck_ende:
  2028.     ENDIF
  2029.     '
  2030.     '
  2031.     IF simulat%<simu%
  2032.       ERASE hy()
  2033.       ERASE intensi()
  2034.       ERASE huelk%()
  2035.       CLR bi%,proz,bildbereich,b,sw,sweep,auf,auf1,simgauss%,simlorentz%,simgauss_lorentz%
  2036.     ENDIF
  2037.     '
  2038.     rettung!=0
  2039.     '
  2040.     CLS
  2041.     DEFTEXT 1,0,0,13
  2042.     PRINT "Nächste simulation"
  2043.     '
  2044.     '
  2045.     '
  2046.   NEXT simulat%
  2047.   ERASE auswahl$()
  2048.   ERASE quark$()
  2049.   robotende:
  2050.   f_ormstupid!=FALSE
  2051.   CLS
  2052. RETURN
  2053. '
  2054. rettung:              ! Versuch um Daten vor dem Endgültigem Vergessen
  2055. CLOSE #1              ! zu retten
  2056. rettung!=-1
  2057. anzahl%=simu%-simulat%         ! Einlesen der Startdaten in den Arbeitsspeicher
  2058. IF anzahl%>0
  2059.   DIM datensatz(50,anzahl%)
  2060.   ARRAYFILL datensatz(),-1
  2061.   simret%=0
  2062.   FOR i=1 TO anzahl%
  2063.     k%=0
  2064.     INC simulat%
  2065.     INC simret%
  2066.     OPEN "i",#1,quark$(simulat%)
  2067.     WHILE NOT EOF(#1)
  2068.       INC k%
  2069.       INPUT #1,datensatz(k%,simret%)
  2070.     WEND
  2071.     CLOSE
  2072.     KILL quark$(simulat%)    ! Löschen des Startdaten -files
  2073.   NEXT i
  2074. ENDIF
  2075. ALERT 1," DIESER FILE KANN | GERETTET WERDEN! | DAZU NEUE DISK EINLEGEN | UND WEITERMACHEN !",1," WEITER | ACHWAS ",was%
  2076. IF was%=2
  2077.   GOTO neustart
  2078. ENDIF
  2079. was_soll_das:
  2080. ALERT 2," | NEUE DISKETTE | EINGELEGT ?",1," NA KLAR ",d%
  2081. IF BIOS(&H9,laufwerk%)=0
  2082.   GOTO was_soll_das
  2083. ENDIF
  2084. ALERT 2," |  DISKETTE FORMATIEREN ?| ",2," JA | NEIN ",f%
  2085. IF f%=1
  2086.   GOSUB format
  2087.   CHDIR "\"
  2088.   MKDIR "DATEN"
  2089. ENDIF
  2090. GOSUB datenordner
  2091. '
  2092. IF anzahl%>0               ! Start Datensatz auf neue Diskette schreiben
  2093.   simulat%=simu%-anzahl%
  2094.   FOR simret%=1 TO anzahl%
  2095.     INC simulat%
  2096.     OPEN "O",#1,quark$(simulat%)
  2097.     k%=1
  2098.     WHILE NOT datensatz(k%,simret%)=-1
  2099.       WRITE #1,datensatz(k%,simret%)
  2100.       INC k%
  2101.     WEND
  2102.     CLOSE
  2103.   NEXT simret%
  2104. ENDIF
  2105. '
  2106. GOSUB robot               ! Weiter gehts
  2107. GOTO neustart
  2108. '
  2109. '
  2110. '
  2111. PROCEDURE format
  2112.   MENU OFF
  2113.   '
  2114.   ALERT 3," | SICHER, DAß DIESE | DISKETTE FORMATIERT | WERDEN SOLL ?",1," JA | ABBRUCH ",format%
  2115.   IF format%=2
  2116.     GOTO schluss
  2117.   ENDIF
  2118.   '
  2119.   puffer$=SPACE$(10000)          ! PUFFER EINRICHTEN
  2120.   wort=VARPTR(puffer$)
  2121.   '
  2122.   ' *********** EINGABE DER PARAMETER ********************
  2123.   '
  2124.   initialisierung:
  2125.   ALERT 2,"Anzahl der Tracks ?",2,"80|81|82",track%
  2126.   IF track%=2 THEN
  2127.     anz_track%=81
  2128.   ENDIF
  2129.   IF track%=1 THEN
  2130.     anz_track%=80
  2131.   ENDIF
  2132.   IF track%=3
  2133.     anz_track%=82
  2134.   ENDIF
  2135.   '
  2136.   ALERT 2,"Sektoren pro Track ?",1,"9|10|ABBRUCH",track%
  2137.   IF track%=2 THEN
  2138.     s.t=10
  2139.   ENDIF
  2140.   IF track%=1
  2141.     s.t=9
  2142.   ENDIF
  2143.   IF track%=3
  2144.     GOTO schluss
  2145.   ENDIF
  2146.   '
  2147.   ALERT 2,"Wie viele Seiten| formatieren ?",2,"Eine|Zwei|Keine",seiten
  2148.   IF seiten=3
  2149.     GOTO schluss
  2150.   ENDIF
  2151.   '
  2152.   ' *********** GRUNDPARAMETER SETZEN *****************
  2153.   '
  2154.   wert=&HE5E5
  2155.   konst=&H87654321
  2156.   r.folge=1
  2157.   side=0
  2158.   drive=0
  2159.   '
  2160.   CLS
  2161.   DEFTEXT 1,0,0,26,
  2162.   '
  2163.   ' **** TRACK 1 SEITE 1 UND TRACK 1 SEITE 2 (NUR DOPPELS.) FORMAT ****
  2164.   '
  2165.   a=XBIOS(10,L:wort,L:0,drive,s.t,0,0,r.folge,L:konst,0)
  2166.   GOSUB auswertung
  2167.   IF seiten=2
  2168.     a=XBIOS(10,L:wort,L:0,drive,s.t,0,1,r.folge,L:konst,0)
  2169.     GOSUB auswertung
  2170.   ENDIF
  2171.   '
  2172.   ' ********* ALLE ÜBRIGEN TRACKS FORMATIEREN ******************
  2173.   '
  2174.   FOR track%=1 TO anz_track%-1
  2175.     '
  2176.     seite_1_oder_seite_2_format:
  2177.     a=XBIOS(10,L:wort,L:0,drive,s.t,track%,side,r.folge,L:konst,wert)
  2178.     GOSUB auswertung
  2179.     IF seiten=2
  2180.       side=side XOR 1       ! AUF ANDERE SEITE UMSCHALTEN
  2181.       IF side=1
  2182.         GOTO seite_1_oder_seite_2_format
  2183.       ENDIF
  2184.     ENDIF
  2185.   NEXT track%
  2186.   '
  2187.   ' ********* BOOTSEKTOR ERSTELLEN *****************
  2188.   '
  2189.   a=XBIOS(18,L:wort,L:0,seiten+1,0)
  2190.   '
  2191.   anz_sektoren%=anz_track%*s.t*seiten
  2192.   hi_byte%=anz_sektoren%/256
  2193.   low_byte%=anz_sektoren%-hi_byte%*256
  2194.   '
  2195.   POKE wort+19,low_byte%   ! GESAMMTANZAHL DER SEKTOREN DER DISK EINTRAGEN
  2196.   POKE wort+20,hi_byte%
  2197.   '
  2198.   IF seiten=1
  2199.     POKE wort+21,&HF8      ! EINSEITIGE DISK
  2200.   ELSE
  2201.     POKE wort+21,&HF9      ! DOPPELSEITIGE DISK
  2202.   ENDIF
  2203.   '
  2204.   POKE wort+24,s.t         ! SEKTOREN PRO TRACK EINTRAGEN
  2205.   POKE wort+25,0
  2206.   '
  2207.   ' **************** BOOTSEKTOR SCHREIBEN *************
  2208.   '
  2209.   a=XBIOS(9,L:wort,L:0,drive,1,0,0,1)
  2210.   '
  2211.   ' *************** GRUNDEINTRÄGE DER FAT ERSTELLEN  ************
  2212.   '
  2213.   LPOKE wort,&HF7FFFF00
  2214.   FOR i=3 TO 511
  2215.     POKE wort+i,0
  2216.   NEXT i
  2217.   '
  2218.   ' ******* 1.FAT BEI EIN- UND ZWEISEITIGER DISK SCHREIBEN ********
  2219.   '
  2220.   anf_sek%=2
  2221.   anz_sek%=1
  2222.   track%=0
  2223.   a=XBIOS(9,L:wort,L:0,drive,anf_sek%,track%,side,anz_sek%)
  2224.   '
  2225.   ' ********* 2. FAT BEI EIN-UND ZWEISEITIGER DISK SCHREIBEN ******
  2226.   '
  2227.   anf_sek%=7
  2228.   a=XBIOS(9,L:wort,L:0,drive,anf_sek%,track%,side,anz_sek%)
  2229.   '
  2230.   schluss:
  2231. RETURN
  2232. ' *************** FEHLERAUSWERTUNG ***********************
  2233. '
  2234. PROCEDURE auswertung
  2235.   IF a=0
  2236.     x%=CINT(3600/anz_track%)
  2237.     w%=x%*track%
  2238.     IF track%=anz_track%-1
  2239.       w%=3600
  2240.     ENDIF
  2241.     IF seiten=2
  2242.       DEFFILL 1,2,9
  2243.       PCIRCLE 320,200,150,0,w%
  2244.       DEFFILL 1,2,19
  2245.       PCIRCLE 320,200,75,0,w%
  2246.     ELSE
  2247.       DEFFILL 1,2,1
  2248.       PCIRCLE 320,200,150,0,w%
  2249.     ENDIF
  2250.   ELSE
  2251.     alarm$="FEHLER AUF| |SEITE "+STR$(side)+"   TRACK "+STR$(track%)
  2252.     ALERT 1,alarm$,1," ABBRUCH | WEITER ",e%
  2253.     IF e%=1
  2254.       RESUME neustart
  2255.     ENDIF
  2256.   ENDIF
  2257. RETURN
  2258. '
  2259. PROCEDURE hardcopy    ! Der Name sagt auch schon alles
  2260.   LOCAL i%,l%,spek$
  2261.   IF OUT?(0)=FALSE    ! übliche Überprüfungen
  2262.     ALERT 3," |     DRUCKER BITTE     | EINSCHALTEN ! ",1," JA JA | MOG NET ",soso%
  2263.     IF soso%=2
  2264.       GOTO copy_ende
  2265.     ENDIF
  2266.   ENDIF
  2267.   IF OUT?(0)=FALSE
  2268.     DEFTEXT 1,1,0,13
  2269.     PRINT AT(30,10);" WITZBOLD !!"
  2270.     PAUSE 30
  2271.     GOTO copy_ende
  2272.   ENDIF
  2273.   IF f_ormstupid!=FALSE
  2274.     ALERT 2," | AUSDRUCK MIT | PARAMETER ? ",1," NA KLAR | QUATSCH ",par%
  2275.     IF par%=1
  2276.       GOSUB datendruck
  2277.     ENDIF
  2278.   ENDIF
  2279.   DEFTEXT 1,17,0,17
  2280.   TEXT 150,150,300,"BIN BEIM DRUCKEN "
  2281.   MENU OFF        ! Hardcopyrutine
  2282.   LPRINT CHR$(27);CHR$(108);CHR$(5);  ! linker Rand
  2283.   LPRINT CHR$(27);CHR$(65);CHR$(8);    ! Zeilenvorschub auf 8/60 Zoll
  2284.   FOR i%=1 TO 80
  2285.     spek$=""
  2286.     FOR l%=399 TO 0 STEP -1
  2287.       spek$=spek$+MID$(x1$,(l%*80)+i%,1)
  2288.     NEXT l%
  2289.     LPRINT CHR$(27);"*";CHR$(0);CHR$(144);CHR$(1);spek$
  2290.   NEXT i%
  2291.   LPRINT CHR$(13);
  2292.   LPRINT CHR$(12);                          ! Nächste Seite
  2293.   LPRINT CHR$(27);CHR$(64);                 ! DRUCKER RESET
  2294.   '
  2295.   DO
  2296.     EXIT IF OUT?(0)=TRUE
  2297.   LOOP
  2298.   '
  2299.   '
  2300.   copy_ende:
  2301.   CLS
  2302. RETURN
  2303. '
  2304. PROCEDURE datendruck  ! Ausdruck der Startdatensätze
  2305.   MENU OFF
  2306.   IF messplo!=-1
  2307.     DEFTEXT 1,17,0,17
  2308.     TEXT 50,100,500,"DIE SOLLTE MANN/FRAU SCHON HABEN ! "
  2309.     GOTO datendruckende
  2310.   ENDIF
  2311.   LPRINT CHR$(27);CHR$(108);CHR$(15);                       ! Linker Rand
  2312.   LPRINT CHR$(27);"E";
  2313.   LPRINT finame$
  2314.   LPRINT CHR$(27);"F";
  2315.   LPRINT CHR$(27);CHR$(74);CHR$(90);                        ! Zeilen vorschub
  2316.   LPRINT CHR$(27);CHR$(108);CHR$(15);                       ! Linker Rand
  2317.   LPRINT "Anzahl der unabhängigen Atome:    ";
  2318.   LPRINT nika%;
  2319.   LPRINT CHR$(27);CHR$(74);CHR$(90);                        ! Zeilen vorschub
  2320.   LPRINT CHR$(27);CHR$(108);CHR$(15);                       ! Linker Rand
  2321.   LPRINT CHR$(27);CHR$(45);CHR$(1);                         ! Unterstrichen
  2322.   LPRINT "Kernparameter";
  2323.   LPRINT CHR$(27);CHR$(45);CHR$(0);
  2324.   LPRINT CHR$(27);CHR$(74);CHR$(50);
  2325.   LPRINT CHR$(27);CHR$(108);CHR$(15);
  2326.   FOR i=1 TO nika%
  2327.     LPRINT "Atomgruppe:       ",i
  2328.     LPRINT CHR$(10);
  2329.     LPRINT "Kernspin :        ",ag(i,0);
  2330.     LPRINT CHR$(10);
  2331.     LPRINT "Anzahl der Kerne: ",ag(i,1);
  2332.     LPRINT CHR$(10);
  2333.     LPRINT "Kopplungskonstante",ag(i,2),
  2334.     LPRINT CHR$(10);
  2335.     LPRINT "****************************************"
  2336.     LPRINT CHR$(10);
  2337.   NEXT i
  2338.   LPRINT CHR$(27);CHR$(74);CHR$(90);                      !Zeilen vorschub
  2339.   LPRINT CHR$(27);CHR$(108);CHR$(15);                     !Linker Rand
  2340.   LPRINT "Sweep-width (in Gauss):    ",sweep
  2341.   LPRINT CHR$(10);
  2342.   LPRINT "Halbwertsbreite (in Gauss):",halbwert,
  2343.   LPRINT CHR$(10);
  2344.   LPRINT "Auflösung (in Punkte):    ",auf
  2345.   LPRINT CHR$(10);
  2346.   LPRINT "Prozent Lorentzcharakter:  ",prol*100,
  2347.   LPRINT CHR$(12);
  2348.   '
  2349.   DO
  2350.     EXIT IF OUT?(0)=TRUE
  2351.   LOOP
  2352.   datendruckende:
  2353.   '
  2354. RETURN
  2355. '
  2356. PROCEDURE spin                                         ! Berechnung der nor -
  2357.   LOCAL atome%,anzahl%,aufspaltung%,zaehl%,max%,imax%  ! mierten Intensitäten
  2358.   atome%=ag(k%,1)                                       ! für ungewöhnlich viele
  2359.   aufspaltung%=INT(ag(k%,0)*2+1)                        ! Atome und "seltene"
  2360.   anzahl%=INT(ag(k%,0)*2*ag(k%,1)+1)                     ! Spinquantenzahlen
  2361.   DIM rechenfeld%(anzahl%),inten%(anzahl%)
  2362.   rechenfeld%(1)=1
  2363.   DO
  2364.     DEC atome%
  2365.     EXIT IF atome%<0
  2366.     ARRAYFILL inten%(),0
  2367.     zaehl%=0
  2368.     DO
  2369.       INC zaehl%
  2370.       FOR z%=zaehl% TO (aufspaltung%+zaehl%-1)
  2371.         IF z%<anzahl% OR z%=anzahl%
  2372.           ADD inten%(z%),rechenfeld%(zaehl%)
  2373.         ENDIF
  2374.       NEXT z%
  2375.       EXIT IF zaehl%=anzahl%
  2376.     LOOP
  2377.     SWAP rechenfeld%(),inten%()
  2378.   LOOP
  2379.   max%=INT(anzahl%/2+1)
  2380.   imax%=rechenfeld%(max%)
  2381.   FOR z%=1 TO anzahl%
  2382.     int(k%,z%)=rechenfeld%(z%)/imax%
  2383.   NEXT z%
  2384.   ERASE rechenfeld%()
  2385.   ERASE inten%()
  2386. RETURN
  2387. '
  2388. PROCEDURE aufblasen
  2389.   MENU OFF
  2390.   DEFTEXT 1,0,0,13
  2391.   PRINT AT(25,10);
  2392.   INPUT "VERGRÖßERUNGSFAKTOR: ";ver
  2393.   ver=ABS(ver)
  2394.   PRINT ver
  2395.   IF ver=0
  2396.     ver=1
  2397.   ENDIF
  2398.   GOSUB zeichnung
  2399. RETURN
  2400. '
  2401. PROCEDURE hp7475a
  2402.   MENU OFF
  2403.   BOUNDARY 1
  2404.   LOCAL stil%,lin%,leng,xin,yin,a,a$,x1,y1,maus,beenden!,yw%,penr%,pens%
  2405.   LOCAL butt%,antwort%,i%,z%,p1%,m_sweep,s_sweep
  2406.   m_sweep=ROUND(mend-manf,2)
  2407.   s_sweep=ROUND(mb-amb,2)
  2408.   IF simess!=-1
  2409.     z%=2
  2410.   ELSE
  2411.     z%=1
  2412.   ENDIF
  2413.   DO UNTIL i%=z%
  2414.     INC i%
  2415.     IF i%=2
  2416.       TEXT 460,80,penr%
  2417.       TEXT 460,230,pens%
  2418.     ENDIF
  2419.     stift:
  2420.     GRAPHMODE 2
  2421.     DEFFILL 1,2,1
  2422.     PBOX 300,20,360,50
  2423.     DEFFILL 1,0
  2424.     DEFTEXT 1,16,0,18
  2425.     TEXT 160,80,300,"STIFT FÜR DEN RAHMEN: "
  2426.     TEXT 160,230,300,"STIFT FÜR DAS SPEKTRUM: "
  2427.     DEFTEXT 1,0,0,15
  2428.     IF simess!=-1
  2429.       IF i%=1
  2430.         TEXT 110,43,170,"SIMULIERTES - "
  2431.       ELSE
  2432.         TEXT 100,43,"GEMESSENES - "
  2433.       ENDIF
  2434.       TEXT 400,43,170,"SPEKTRUM"
  2435.     ENDIF
  2436.     TEXT 315,43,30,"OK"
  2437.     '
  2438.     BOX 40,350,600,380
  2439.     TEXT 50,370,100,"LINIENFORM:"
  2440.     IF i%=1
  2441.       TEXT 350,370,"PATTERNLÄNGE:"
  2442.       lin%=0
  2443.     ENDIF
  2444.     xin=30
  2445.     yin=130
  2446.     a$="1"
  2447.     a=1
  2448.     FOR i=1 TO 6
  2449.       ADD xin,80
  2450.       x1=xin
  2451.       y1=yin
  2452.       FOR d=1 TO 2
  2453.         TEXT x1+16,y1+24,a$
  2454.         x2=x1+40
  2455.         y2=y1+40
  2456.         PBOX x1,y1,x2,y2
  2457.         y1=yin+150
  2458.       NEXT d
  2459.       INC a
  2460.       a$=STR$(a)
  2461.     NEXT i
  2462.     maus=0
  2463.     GRAPHMODE 1
  2464.     DEFTEXT 1,16,0,18
  2465.     DEFLINE 1,1
  2466.     LINE 180,365,300,365
  2467.     DO
  2468.       IF INKEY$=CHR$(27)
  2469.         maus=2
  2470.         beenden!=-1
  2471.       ENDIF
  2472.       IF INKEY$=CHR$(13)
  2473.         maus=2
  2474.       ENDIF
  2475.       IF MOUSEK=1
  2476.         IF i%=1
  2477.           IF MOUSEY>350 AND MOUSEY<380 AND MOUSEX>350 AND MOUSEX<600
  2478.             INC leng
  2479.             IF leng>20
  2480.               leng=1
  2481.             ENDIF
  2482.             PAUSE 10
  2483.             TEXT 500,370,"    "
  2484.             TEXT 500,370,STR$(leng)
  2485.           ENDIF
  2486.           IF MOUSEY>350 AND MOUSEY<380 AND MOUSEX>180 AND MOUSEX<300
  2487.             INC lin%
  2488.             IF lin%>5
  2489.               lin%=0
  2490.             ENDIF
  2491.             IF lin%=0
  2492.               stil%=1
  2493.             ENDIF
  2494.             IF lin%=1
  2495.               stil%=3
  2496.             ENDIF
  2497.             IF lin%=2
  2498.               stil%=5
  2499.             ENDIF
  2500.             IF lin%=3
  2501.               stil%=2
  2502.             ENDIF
  2503.             IF lin%=4
  2504.               stil%=4
  2505.             ENDIF
  2506.             IF lin%=5
  2507.               stil%=6
  2508.             ENDIF
  2509.             TEXT 180,370,120,"      "
  2510.             DEFLINE stil%,1
  2511.             LINE 180,365,300,365
  2512.             DEFLINE 1,1,0,0
  2513.             PAUSE 10
  2514.           ENDIF
  2515.         ENDIF
  2516.         TEXT 460,80,penr%
  2517.         TEXT 460,230,pens%
  2518.         IF MOUSEY>130 AND MOUSEY<170
  2519.           yw%=1
  2520.         ENDIF
  2521.         IF MOUSEY>280 AND MOUSEY<320
  2522.           yw%=2
  2523.         ENDIF
  2524.         IF MOUSEX>110 AND MOUSEX<150
  2525.           IF yw%=1
  2526.             penr%=1
  2527.           ENDIF
  2528.           IF yw%=2
  2529.             pens%=1
  2530.           ENDIF
  2531.         ENDIF
  2532.         IF MOUSEX>190 AND MOUSEX<230
  2533.           IF yw%=1
  2534.             penr%=2
  2535.           ENDIF
  2536.           IF yw%=2
  2537.             pens%=2
  2538.           ENDIF
  2539.         ENDIF
  2540.         IF MOUSEX>270 AND MOUSEX<310
  2541.           IF yw%=1
  2542.             penr%=3
  2543.           ENDIF
  2544.           IF yw%=2
  2545.             pens%=3
  2546.           ENDIF
  2547.         ENDIF
  2548.         IF MOUSEX>350 AND MOUSEX<390
  2549.           IF yw%=1
  2550.             penr%=4
  2551.           ENDIF
  2552.           IF yw%=2
  2553.             pens%=4
  2554.           ENDIF
  2555.         ENDIF
  2556.         IF MOUSEX>430 AND MOUSEX<470
  2557.           IF yw%=1
  2558.             penr%=5
  2559.           ENDIF
  2560.           IF yw%=2
  2561.             pens%=5
  2562.           ENDIF
  2563.         ENDIF
  2564.         IF MOUSEX>510 AND MOUSEX<550
  2565.           IF yw%=1
  2566.             penr%=6
  2567.           ENDIF
  2568.           IF yw%=2
  2569.             pens%=6
  2570.           ENDIF
  2571.         ENDIF
  2572.         IF MOUSEX>300 AND MOUSEX<360 AND MOUSEY>20 AND MOUSEY<50
  2573.           maus=2
  2574.         ENDIF
  2575.       ENDIF
  2576.       EXIT IF maus=2
  2577.     LOOP
  2578.     IF z%=2 AND i%=1
  2579.       pr%=penr%
  2580.       ps1%=pens%
  2581.     ENDIF
  2582.     IF beenden!=-1
  2583.       GOTO hp_ende
  2584.     ENDIF
  2585.     rahmen_aus!=FALSE
  2586.     IF penr%=0
  2587.       ALERT 2," |  KEINE BESCHRIFTUNG ??? ",1," HÄ ? | EIJO ! ",butt%
  2588.       IF butt%=1
  2589.         GOTO stift
  2590.       ELSE
  2591.         rahmen_aus!=TRUE
  2592.       ENDIF
  2593.     ENDIF
  2594.     IF pens%=0
  2595.       ALERT 2," |  KEIN SPEKTRUM ?????? ",1," OHJE ! | JA | ???? ",butt%
  2596.       IF butt%=1
  2597.         GOTO stift
  2598.       ENDIF
  2599.       IF butt%=2
  2600.         ALERT 2," |  SCHWABE ODER SCHOTTE ? ",2," SO ISSES | HANOI ",antwort%
  2601.         IF antwort%=2
  2602.           CLS
  2603.           TEXT 100,150,400," SELTSAM, SELTSAM........"
  2604.           PAUSE 120
  2605.         ENDIF
  2606.       ENDIF
  2607.       IF butt%=3
  2608.         ALERT 2," SIND SIE EIN | | ORGANIKER ? ",1," JA | NEIN ",antwort%
  2609.         CLS
  2610.         IF antwort%=1
  2611.           TEXT 100,150,400," DACHT ICH MIR DOCH GLEICH!"
  2612.         ELSE
  2613.           TEXT 100,150,400," HÄTTEN SIE ABER WERDEN KÖNNEN ! "
  2614.         ENDIF
  2615.         PAUSE 120
  2616.       ENDIF
  2617.     ENDIF
  2618.     IF penr%=0 AND pens%=0
  2619.       CLS
  2620.       TEXT 150,150,300,"GEIZHALS!!!!!"
  2621.       PAUSE 150
  2622.       CLS
  2623.       GOTO stift
  2624.     ENDIF
  2625.     '
  2626.     IF i%=1
  2627.       p1%=pens%
  2628.     ENDIF
  2629.     CLS
  2630.   LOOP
  2631.   ALERT 2,"  |  PLOTTEN ?",1," EI JO | NEEEE ",butt%
  2632.   IF butt%=2
  2633.     GOTO hp_ende
  2634.   ENDIF
  2635.   TEXT 160,150,300,"Bin beim Plotten!"
  2636.   '
  2637.   OPEN "",#3,"AUX:"
  2638.   PRINT #3,"IN;"
  2639.   IF rahmen_aus!=FALSE
  2640.     GOSUB text
  2641.     DELAY 50
  2642.     GOSUB rahmen
  2643.     DELAY 80
  2644.   ENDIF
  2645.   GOSUB plott
  2646.   PRINT #3,"PU;SP0"
  2647.   PRINT #3,"DF"
  2648.   CLOSE #3
  2649.   hp_ende:
  2650.   CLS
  2651.   DEFLINE 1,1
  2652. RETURN
  2653. '
  2654. PROCEDURE text
  2655.   prozl=prol*100
  2656.   PRINT #3,"SP";penr%;
  2657.   PRINT #3,"pa2000,7480;"
  2658.   PRINT #3,"CS0;SR3,3;"
  2659.   PRINT #3,"lbSYSIPHUS - PLOT";CHR$(3)
  2660.   PRINT #3,"Pa2020,7460;LbSYSIPHUS - PLOT";CHR$(3)
  2661.   PRINT #3,"PA600,7350,PD10600,7350,PU;"
  2662.   PRINT #3,"SR.7,1;"
  2663.   IF (bereichsplott! OR huell!) OR simess!
  2664.     PRINT #3,"PA2800,7200;LBSIMULIERTES SPEKTRUM: ";CHR$(3)
  2665.     IF lin%>0
  2666.       PRINT #3,"LT",lin%,leng;
  2667.     ENDIF
  2668.     PRINT #3,"SP";p1%;"VS,2;"
  2669.     PRINT #3,"PA5500,7225,PD8000,7225,PU;"
  2670.     PRINT #3,"SP";penr%;
  2671.     PRINT #3,"LT,VS;";
  2672.     PRINT #3,"PA600,7050;LBFILENAME: ";finame$;CHR$(3)
  2673.     PRINT #3,"PA3800,7050;CS33;LBAUFL";CHR$(92);"SUNG: ";auf;CHR$(3)
  2674.     PRINT #3,"PA7000,7050;LB%-LORENTZCHARAKTER: ";prozl;CHR$(3)
  2675.     PRINT #3,"PA600,6925;CS0;LBHALBWERSTBREITE: ";halbwert;CHR$(3)
  2676.     PRINT #3,"PA3800,6925;LBSIMULIERTE SWEEP-WEITE: ";sw;CHR$(3)
  2677.     PRINT #3,"PA7000,6925;LBSWEEP-WEITE: ";s_sweep;CHR$(3)
  2678.     DELAY 10
  2679.   ENDIF
  2680.   PRINT #3,"PA600,6775,PD10600,6775,PU;"
  2681.   IF messplo!=-1
  2682.     PRINT #3,"PA2800,6625;LBGEMESSENES SPEKTRUM: ";CHR$(3)
  2683.     PRINT #3,"sp",pens%;"VS,2;"
  2684.     PRINT #3,"PA5500,6650,PD8000,6650,PU;"
  2685.     PRINT #3,"sp";penr%;"VS;"
  2686.     PRINT #3,"PA600,6500;LBFILENAME: ";mess$;CHR$(3)
  2687.     PRINT #3,"PA3800,6500;LBRESOLUTION: ";res%;CHR$(3)
  2688.     PRINT #3,"PA7000,6500;LBCENTERFIELD: ";ROUND(cf,2);CHR$(3)
  2689.     PRINT #3,"PA600,6375;LBGEMESSENE SWEEP-WEITE: ";spsw;CHR$(3)
  2690.     PRINT #3,"PA7000,6375;LBSWEEP-WEITE: ";m_sweep;CHR$(3)
  2691.     PRINT #3,"PA600,6225,PD10600,6225,PU;"
  2692.     DELAY 10
  2693.   ENDIF
  2694. RETURN
  2695. '
  2696. PROCEDURE rahmen
  2697.   LOCAL l$,r$,mit$,s_sweep,m_sweep,lm$,rm$,mitm$,ls$,rs$,mits$
  2698.   s_sweep=ROUND(mb-amb,2)
  2699.   m_sweep=ROUND(mend-manf,2)
  2700.   '
  2701.   lm$=SPACE$(7)
  2702.   RSET lm$=STR$(ROUND(manf,2))
  2703.   rm$=SPACE$(7)
  2704.   rm$=STR$(ROUND(mend,2))
  2705.   mitm$=SPACE$(7)
  2706.   RSET mitm$=STR$(m_sweep)
  2707.   l1$=STR$(ROUND(amb,2))
  2708.   IF l1$="0"
  2709.     l1$="0.00"
  2710.   ENDIF
  2711.   ls$=l1$
  2712.   rs$=STR$(ROUND(mb,2))
  2713.   mits$=STR$(s_sweep)
  2714.   l$=SPACE$(7)
  2715.   mit$=SPACE$(7)
  2716.   r$=SPACE$(7)
  2717.   '
  2718.   PRINT #3,"PU,600,600,PD,600,5620,10600,5620,10600,600,600,600;"
  2719.   PRINT #3,"PU600,600,PD600,520,PU,5600,600,PD,5600,520,PU10600,600PD10600,520,PU;"
  2720.   IF simess!=-1
  2721.     PRINT #3,"PU600,5620,PD600,5700,PU,5600,5620,PD,5600,5700,PU10600,5620PD10600,5700,PU;"
  2722.   ENDIF
  2723.   IF simess!=-1
  2724.     RSET l$=ls$
  2725.     RSET mit$=mits$
  2726.     RSET r$=rs$
  2727.   ELSE
  2728.     IF messplo!=-1
  2729.       RSET l$=lm$
  2730.       RSET mit$=mitm$
  2731.       RSET r$=rm$
  2732.     ELSE
  2733.       RSET l$=ls$
  2734.       RSET r$=rs$
  2735.       RSET mit$=mits$
  2736.     ENDIF
  2737.   ENDIF
  2738.   PRINT #3,"PA80,380,LB"+l$;CHR$(3)
  2739.   PRINT #3,"PA4000,380,LBSWEEP-WEITE"+mit$+" GAUSS";CHR$(3)
  2740.   PRINT #3,"PA10100,380,LB"+r$;CHR$(3)
  2741.   IF simess!=-1
  2742.     PRINT #3,"PA80,5900,LB"+lm$;CHR$(3)
  2743.     PRINT #3,"PA4000,5800,LBSWEEP-WEITE"+mitm$+" GAUSS";CHR$(3)
  2744.     PRINT #3,"PA10100,5800,LB"+rm$;CHR$(3)
  2745.   ENDIF
  2746. RETURN
  2747. '
  2748. PROCEDURE plott
  2749.   LOCAL x%,y%,app%,plo%,links%,vgl,off%
  2750.   PRINT #3,"IP600,600,10600,5620;"
  2751.   IF simess!=-1
  2752.     IF halb!=-1
  2753.       vgl=0.5
  2754.       off%=5000
  2755.     ELSE
  2756.       vgl=1
  2757.       off%=0
  2758.     ENDIF
  2759.   ELSE
  2760.     vgl=1
  2761.     off%=0
  2762.   ENDIF
  2763.   IF messplo!=-1
  2764.     PRINT #3,"SP";pens%;
  2765.     app%=mende%-mstart%+1
  2766.     PRINT #3,"SC1",app%,"-10010,10010;"
  2767.     PRINT #3,"PU,1,0;"
  2768.     PRINT #3,"PA",1,off%;
  2769.     IF mstart%<res%
  2770.       y%=mstart%
  2771.       DO
  2772.         INC x%
  2773.         IF y%<1
  2774.           plo%=0
  2775.           PRINT #3,"PU";
  2776.           plo%=off%
  2777.         ELSE
  2778.           PRINT #3,"PD";
  2779.           plo%=CINT(spek%(y%)*vgl/100)+off%
  2780.         ENDIF
  2781.         IF plo%>10010
  2782.           plo%=10010
  2783.         ENDIF
  2784.         IF halb!=-1
  2785.           IF plo%<0
  2786.             plo%=0
  2787.           ENDIF
  2788.         ENDIF
  2789.         IF plo%<-10010
  2790.           plo%=-10010
  2791.         ENDIF
  2792.         PRINT #3,"PA",x%,plo%;
  2793.         DELAY 0.5
  2794.         IF y%=res%
  2795.           x%=app%
  2796.         ENDIF
  2797.         EXIT IF x%=app%
  2798.         INC y%
  2799.       LOOP
  2800.       PRINT #3,"PU;"
  2801.     ENDIF
  2802.   ENDIF
  2803.   '
  2804.   IF (huell! OR bereichsplott!) OR simess!
  2805.     IF lin%=0
  2806.       PRINT #3,"LT";
  2807.     ELSE
  2808.       PRINT #3,"LT",lin%,leng;
  2809.     ENDIF
  2810.     PRINT #3,"SP";p1%;
  2811.     vgl=ver*vgl
  2812.     off%=-off%
  2813.     app%=5860
  2814.     PRINT #3,"SC1",app%,"-10010,10010;"
  2815.     PRINT #3,"PU,1,0;"
  2816.     PRINT #3,"PA",1,off%,"PD;"
  2817.     IF gerade!=TRUE
  2818.       PRINT #3,"VS",2,";"
  2819.       PRINT #3,"PA",app%,off%;
  2820.       PRINT #3,"VS",";"
  2821.     ELSE
  2822.       xa%=(start%-27)*10
  2823.       IF xa%=0
  2824.         xa%=1
  2825.       ENDIF
  2826.       PRINT #3,"VS",1,";"
  2827.       PRINT #3,"PA",xa%,off%;
  2828.       PRINT #3,"VS",";"
  2829.       FOR y%=anfang% TO ende%
  2830.         x%=(y%-anfang%)*fak*10+xa%
  2831.         plo%=CINT(-huelk%(kurve%-1,y%)*vgl/100)+off%
  2832.         IF plo%>10010
  2833.           plo%=10010
  2834.         ENDIF
  2835.         IF halb!=-1
  2836.           IF plo%>0
  2837.             plo%=0
  2838.           ENDIF
  2839.         ENDIF
  2840.         IF plo%<-10010
  2841.           plo%=-10010
  2842.         ENDIF
  2843.         PRINT #3,"PA";x%,plo%;
  2844.         DELAY 0.5
  2845.       NEXT y%
  2846.       PRINT #3,"VS",1,";"
  2847.       PRINT #3,"PA",app%,off%;
  2848.       PRINT #3,"VS",";"
  2849.     ENDIF
  2850.   ENDIF
  2851.   '
  2852. RETURN
  2853. '
  2854. PROCEDURE pixel
  2855.   MENU OFF
  2856.   LOCAL wahl$,c$,punkt%,d%,bakl%,button%,l$
  2857.   '
  2858.   IF messplo!=-1
  2859.     c$=mess$
  2860.   ELSE
  2861.     punkt%=RINSTR(finame$,".")
  2862.     bakl%=RINSTR(finame$,"\")
  2863.     d%=punkt%-bakl%-1
  2864.     IF d%<0
  2865.       d%=8
  2866.     ENDIF
  2867.     c$=MID$(finame$,bakl%+1,d%)
  2868.     ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2869.   ENDIF
  2870.   '
  2871.   pixelanf:
  2872.   l$=CHR$(GEMDOS(25)+65)
  2873.   '
  2874.   FILESELECT l$+":\*.PIC",c$+".PIC",wahl$
  2875.   IF wahl$>""
  2876.     IF EXIST(wahl$)
  2877.       ALERT 1," DATEI EXISTIERT SCHON ! | ACHTUNG ! | DIE DATEI WIRD ÜBERSCHRIEBEN !",1," ABBRUCH | WEITER ",buton%
  2878.       IF buton%=1
  2879.         GOTO pixelanf
  2880.       ENDIF
  2881.     ENDIF
  2882.     CLS
  2883.     SPUT x1$
  2884.     OPEN "O",#1,wahl$
  2885.     BPUT #1,XBIOS(2),32000
  2886.     CLOSE
  2887.   ENDIF
  2888. RETURN
  2889. '
  2890. '
  2891. PROCEDURE gwert
  2892.   MENU OFF
  2893.   LOCAL stand1$,stand2$,stand3$,b1$,b2$,b1,b2
  2894.   CLS
  2895.   DIM stand$(3)
  2896.   CHDIR "\"
  2897.   CHDIR "\DATEN"
  2898.   IF EXIST("G_WERT.PAR")
  2899.     OPEN "I",#1,"G_WERT.PAR"
  2900.     INPUT #1,wahl$
  2901.     INPUT #1,b1,b2
  2902.     CLOSE
  2903.     IF EXIST(wahl$)
  2904.       OPEN "I",#1,wahl$
  2905.       FOR i%=1 TO 3
  2906.         INPUT #1,stand$(i%)
  2907.       NEXT i%
  2908.     ENDIF
  2909.     CLOSE
  2910.   ENDIF
  2911.   GOSUB gwertbeschrift
  2912.   CLS
  2913.   ERASE stand$()
  2914. RETURN
  2915. PROCEDURE gwertbeschrift
  2916.   CLS
  2917.   stand1$=stand$(1)
  2918.   stand2$=stand$(2)
  2919.   stand3$=stand$(3)
  2920.   b1$=SPACE$(7)
  2921.   b2$=SPACE$(7)
  2922.   b1$=STR$(b1)
  2923.   b2$=STR$(b2)
  2924.   GOSUB muster
  2925.   GOSUB kaufhaus
  2926. RETURN
  2927. PROCEDURE muster
  2928.   DEFMOUSE bitmuster$
  2929.   DEFTEXT 1,0,0,13
  2930.   BOX 30,40,610,360
  2931.   BOX 40,50,600,350
  2932.   FILL 45,45
  2933.   BOX 160,60,480,80
  2934.   TEXT 170,75,300,"g-WERT-Berechnung"
  2935.   BOX 70,100,590,120
  2936.   TEXT 75,115,80,"Standard:"
  2937.   TEXT 170,115,stand1$
  2938.   BOX 70,130,590,150
  2939.   TEXT 75,145,80,"g-WERT:"
  2940.   TEXT 170,145,stand2$
  2941.   BOX 70,160,590,180
  2942.   TEXT 75,175,80,"Kommentar:"
  2943.   TEXT 170,175,stand3$
  2944.   BOX 70,189,590,211
  2945.   TEXT 75,205,115,"Feld [ in Gauß ]"
  2946.   BOX 73,191,587,209
  2947.   FILL 71,190
  2948.   DEFLINE 1,3
  2949.   LINE 205,190,205,210
  2950.   TEXT 220,205,70,"Standard:"
  2951.   DEFLINE 0,0
  2952.   BOX 293,190,308,210
  2953.   BOX 383,190,398,210
  2954.   BOX 473,190,488,210
  2955.   BOX 563,190,578,210
  2956.   TEXT 296,206,"⇦"
  2957.   TEXT 296,206,"⇦"
  2958.   TEXT 386,206,"⇨"
  2959.   TEXT 476,206,"⇦"
  2960.   TEXT 566,206,"⇨"
  2961.   TEXT 310,205,70,b1$
  2962.   TEXT 400,205,70,"Probe:"
  2963.   TEXT 490,205,70,b2$
  2964.   DEFLINE 1,0
  2965.   BOX 160,225,480,255
  2966.   BOX 155,220,485,260
  2967.   DEFFILL 1,2,9
  2968.   FILL 158,256
  2969.   DEFTEXT 1,16,0,17
  2970.   TEXT 170,247,100,"g-Wert ="
  2971.   BOX 350,270,580,340
  2972.   BOX 70,270,300,340
  2973.   BOX 100,275,270,295
  2974.   BOX 100,310,270,330
  2975.   BOX 380,275,550,295
  2976.   DEFTEXT 1,0,0,13
  2977.   TEXT 400,290,130," Standard "
  2978.   TEXT 120,290,130," Berechnen "
  2979.   TEXT 120,325,130,"   ADELE   "
  2980.   BOX 360,310,420,330
  2981.   BOX 435,310,495,330
  2982.   BOX 510,310,570,330
  2983.   TEXT 365,325,50,"NEUER"
  2984.   TEXT 440,325,50,"LADEN"
  2985.   TEXT 512,325,55,"SICHERN"
  2986.   DEFFILL 1,4
  2987.   FILL 72,272
  2988.   DEFFILL 1,2,16
  2989.   FILL 352,272
  2990.   DEFFILL 1,2,20
  2991.   FILL 55,55
  2992. RETURN
  2993. PROCEDURE kaufhaus
  2994.   DEFMOUSE bitmuster$
  2995.   DO
  2996.     IF MOUSEY>190 AND MOUSEY<210
  2997.       IF MOUSEK>0
  2998.         IF MOUSEX>293 AND MOUSEX<308
  2999.           p%=1
  3000.           GOSUB aufnieder1
  3001.         ENDIF
  3002.         IF MOUSEX>383 AND MOUSEX<398
  3003.           p%=2
  3004.           GOSUB aufnieder1
  3005.         ENDIF
  3006.         IF MOUSEX>473 AND MOUSEX<488
  3007.           p%=3
  3008.           GOSUB aufnieder2
  3009.         ENDIF
  3010.         IF MOUSEX>565 AND MOUSEX<578
  3011.           p%=4
  3012.           GOSUB aufnieder2
  3013.         ENDIF
  3014.       ENDIF
  3015.     ENDIF
  3016.     IF MOUSEX>100 AND MOUSEX<270
  3017.       IF MOUSEK>0
  3018.         IF MOUSEY>275 AND MOUSEY<295
  3019.           GOSUB berechnen
  3020.         ENDIF
  3021.         IF MOUSEY>310 AND MOUSEY<330
  3022.           GOTO gwertende
  3023.         ENDIF
  3024.       ENDIF
  3025.     ENDIF
  3026.     IF MOUSEY>310 AND MOUSEY<330
  3027.       IF MOUSEK>0
  3028.         IF MOUSEX>360 AND MOUSEX<420
  3029.           GOSUB dateneingabe
  3030.         ENDIF
  3031.         IF MOUSEX>435 AND MOUSEX<495
  3032.           GOSUB lade
  3033.           GOSUB gwertbeschrift
  3034.         ENDIF
  3035.         IF MOUSEX>510 AND MOUSEX<570
  3036.           GOSUB speicher
  3037.         ENDIF
  3038.       ENDIF
  3039.     ENDIF
  3040.   LOOP
  3041.   gwertende:
  3042. RETURN
  3043. PROCEDURE aufnieder1
  3044.   IF p%=1
  3045.     IF MOUSEK=1
  3046.       ADD b1,0.01
  3047.     ELSE
  3048.       ADD b1,1
  3049.     ENDIF
  3050.     PAUSE 8
  3051.   ENDIF
  3052.   IF p%=2
  3053.     IF MOUSEK=1
  3054.       SUB b1,0.01
  3055.     ELSE
  3056.       SUB b1,1
  3057.     ENDIF
  3058.     PAUSE 8
  3059.   ENDIF
  3060.   b1=ROUND(b1,2)
  3061.   b=b1*100
  3062.   b$=SPACE$(7)
  3063.   RSET b$=STR$(b)
  3064.   b1$=MID$(b$,1,5)+"."+MID$(b$,6)+" "
  3065.   TEXT 310,205,b1$
  3066. RETURN
  3067. PROCEDURE aufnieder2
  3068.   IF p%=3
  3069.     IF MOUSEK=1
  3070.       ADD b2,0.01
  3071.     ELSE
  3072.       ADD b2,1
  3073.     ENDIF
  3074.     PAUSE 8
  3075.   ENDIF
  3076.   IF p%=4
  3077.     IF MOUSEK=1
  3078.       SUB b2,0.01
  3079.     ELSE
  3080.       SUB b2,1
  3081.     ENDIF
  3082.     PAUSE 8
  3083.   ENDIF
  3084.   b2=ROUND(b2,2)
  3085.   b=b2*100
  3086.   b$=SPACE$(7)
  3087.   RSET b$=STR$(b)
  3088.   b2$=MID$(b$,1,5)+"."+MID$(b$,6)+" "
  3089.   TEXT 490,205,70,b2$
  3090. RETURN
  3091. PROCEDURE dateneingabe
  3092.   CLS
  3093.   BOX 40,50,600,360
  3094.   PRINT AT(20,8);
  3095.   PRINT AT(10,8);"Standard: ";stand1$
  3096.   PRINT AT(10,12);"g-Wert:   ";stand2$
  3097.   PRINT AT(10,16);"Kommentar:";stand3$
  3098.   PRINT AT(10,20);"Feld [ in Gauß ]:"
  3099.   PRINT AT(30,20);"Standard:  ";b1$
  3100.   PRINT AT(55,20);"Probe:    ";b2$
  3101.   PRINT AT(20,8);
  3102.   FORM INPUT 50 AS stand1$
  3103.   stand$(1)=stand1$
  3104.   PRINT AT(20,12);
  3105.   FORM INPUT 10 AS stand2$
  3106.   stand$(2)=stand2$
  3107.   PRINT AT(20,16);
  3108.   FORM INPUT 50 AS stand3$
  3109.   stand$(3)=stand3$
  3110.   PRINT AT(41,20);
  3111.   FORM INPUT 7 AS b1$
  3112.   PRINT AT(65,20);
  3113.   FORM INPUT 7 AS b2$
  3114.   b1=VAL(b1$)
  3115.   b2=VAL(b2$)
  3116.   CLS
  3117.   GOSUB muster
  3118. RETURN
  3119. PROCEDURE speicher
  3120.   LOCAL wahl$,l$,but%
  3121.   l$=CHR$(GEMDOS(25)+65)
  3122.   FILESELECT l$+":\daten\*.gwe",".gwe",wahl$
  3123.   IF wahl$=""
  3124.     GOTO schreibend
  3125.   ENDIF
  3126.   OPEN "O",#1,wahl$
  3127.   FOR n%=1 TO 3
  3128.     WRITE #1,stand$(n%)
  3129.   NEXT n%
  3130.   CLOSE
  3131.   ALERT 2,"  SOLLEN DIE PARAMETER | FILENAME UND FELDSRTÄRKEN | MIT ABGESPEICHERT WERDEN? ",1," FREILI | HÄH ",but%
  3132.   IF but%=1
  3133.     OPEN "O",#1,"G_WERT.PAR"
  3134.     WRITE #1,wahl$
  3135.     WRITE #1,b1,b2
  3136.     CLOSE
  3137.   ENDIF
  3138.   schreibend:
  3139.   DEFMOUSE bitmuster$
  3140. RETURN
  3141. PROCEDURE lade
  3142.   LOCAL wahl$,l$,but%
  3143.   l$=CHR$(GEMDOS(25)+65)
  3144.   FILESELECT l$+":\daten\*.GWE",".GWE",wahl$
  3145.   IF wahl$=""
  3146.     GOTO lesend
  3147.   ENDIF
  3148.   IF EXIST(wahl$)
  3149.     OPEN "I",#1,wahl$
  3150.     FOR i%=1 TO 3
  3151.       INPUT #1,stand$(i%)
  3152.     NEXT i%
  3153.     CLOSE
  3154.   ELSE
  3155.     ALERT 1," SORRY OPEN ERROR | | (keine Datei gefunden) ",1,"NICHT OK",but%
  3156.   ENDIF
  3157.   lesend:
  3158.   DEFMOUSE bitmuster$
  3159. RETURN
  3160. PROCEDURE berechnen
  3161.   LOCAL gwert$,g$,gstan,gwert
  3162.   gstan=VAL(stand2$)
  3163.   gwert=gstan*b1/b2
  3164.   gwert$=STR$(gwert)
  3165.   g$=SPACE$(7)
  3166.   LSET g$=MID$(gwert$,1,1)+"."+MID$(gwert$,3,5)+"000000"
  3167.   DEFTEXT 1,16,0,17
  3168.   TEXT 280,247,g$
  3169.   DEFTEXT 1,0,0,13
  3170. RETURN
  3171. '
  3172. '
  3173. PROCEDURE rausch
  3174.   LOCAL r%,x%,y%,i%,l%,maus%,bereich,r,zufall,auf,fak,rausch
  3175.   IF huell!=-1 OR bereichsplott!=-1
  3176.     CLS
  3177.     '
  3178.     BOX 49,150,601,251
  3179.     LINE 49,199,601,199
  3180.     LINE 49,251,49,265
  3181.     LINE 320,251,320,265
  3182.     LINE 601,251,601,265
  3183.     DEFFILL 1,2,14
  3184.     PBOX 100,300,550,350
  3185.     DEFTEXT 1,16,0,13
  3186.     TEXT 120,330,410," Gut gerauscht ist halb betrogen , oder ? "
  3187.     DEFTEXT 1,0,0,13
  3188.     TEXT 40,275,"0 %"
  3189.     TEXT 311,275,"50 %"
  3190.     TEXT 590,275,"100 %"
  3191.     TEXT 100,180,200," Prozent Grundrauschen :"
  3192.     DO UNTIL maus%=1
  3193.       IF MOUSEY>300 AND MOUSEY<350 AND MOUSEX>100 AND MOUSEX<550 AND MOUSEK=1
  3194.         maus%=1
  3195.       ENDIF
  3196.       IF MOUSEK=2
  3197.         maus%=1
  3198.       ENDIF
  3199.       IF INKEY$=CHR$(13)
  3200.         maus%=1
  3201.       ENDIF
  3202.       IF MOUSEY>200 AND MOUSEY<250
  3203.         x%=MOUSEX
  3204.         IF MOUSEK=1
  3205.           IF x%<600 AND x%>50
  3206.             DEFFILL 0
  3207.             BOUNDARY 0
  3208.             PBOX x%,200,600,250
  3209.             DEFFILL 1,2,17
  3210.             BOUNDARY 1
  3211.             PBOX 50,200,x%,250
  3212.             r%=x%-51
  3213.             r=ROUND(r%/5.48,2)
  3214.             TEXT 320,180,"      %"
  3215.             TEXT 320,180,r
  3216.           ENDIF
  3217.         ENDIF
  3218.       ENDIF
  3219.     LOOP
  3220.     '
  3221.     zufall=r*3
  3222.     zufall=ABS(zufall)
  3223.     CLS
  3224.     SPUT x1$
  3225.     DEFFILL 0
  3226.     BOUNDARY 0
  3227.     PBOX 28,61,612,359
  3228.     DRAW 27,210
  3229.     IF huell!=TRUE
  3230.       fa=586/sweep
  3231.       IF sweep>=simsw
  3232.         fak=fa*simsw/bi%
  3233.         anf=(sweep-simsw)/2*fa+27
  3234.         FOR i%=27 TO anf
  3235.           FOR l%=1 TO 4
  3236.             rausch=RANDOM(zufall)
  3237.             r%=210+CINT(rausch-zufall/2)
  3238.             DRAW  TO i%,r%
  3239.           NEXT l%
  3240.         NEXT i%
  3241.         FOR l%=0 TO bi%
  3242.           rausch=RANDOM(zufall)
  3243.           x%=l%*fak+anf
  3244.           y%=CINT(210+huelk%(kurve%-1,l%)*hoehe*ver)
  3245.           r%=y%+CINT(rausch-zufall/2)
  3246.           IF r%>360
  3247.             r%=360
  3248.           ENDIF
  3249.           IF r%<60
  3250.             r%=60
  3251.           ENDIF
  3252.           DRAW  TO x%,r%
  3253.         NEXT l%
  3254.         FOR i%=x% TO 612
  3255.           FOR l%=1 TO 4
  3256.             rausch=RANDOM(zufall)
  3257.             r%=210+CINT(rausch-zufall/2)
  3258.             DRAW  TO i%,r%
  3259.           NEXT l%
  3260.         NEXT i%
  3261.       ELSE
  3262.         anf=sweep/2*ppg+0.5
  3263.         start%=spekha%-INT(anf)
  3264.         bis%=spekha%+INT(anf)
  3265.         fak=586/(bis%-start%)
  3266.         FOR l%=start% TO bis%
  3267.           rausch=RANDOM(zufall)
  3268.           x%=(l%-start%)*fak+27
  3269.           y%=CINT(210+huelk%(kurve%-1,l%)*hoehe*ver)
  3270.           r%=y%+CINT(rausch-zufall/2)
  3271.           IF r%>360
  3272.             r%=360
  3273.           ENDIF
  3274.           IF r%<60
  3275.             r%=60
  3276.           ENDIF
  3277.           DRAW  TO x%,r%
  3278.         NEXT l%
  3279.       ENDIF
  3280.     ENDIF
  3281.     IF bereichsplott!=TRUE
  3282.       IF le%=0
  3283.         PRINT AT(30,14);"WAR WOHL NIX !";
  3284.         GOTO warnix
  3285.       ENDIF
  3286.       bereich%=le%-la%
  3287.       fak=586/bereich%
  3288.       bereichshalbe%=bereich%/2+la%
  3289.       IF la%>bi%
  3290.         GOTO gerade2
  3291.       ENDIF
  3292.       IF la%<0 OR la%=0
  3293.         anfang%=0
  3294.         start%=CINT(ABS(la%*fak)+27)
  3295.       ENDIF
  3296.       IF la%>0
  3297.         anfang%=la%
  3298.         start%=27
  3299.       ENDIF
  3300.       IF le%<0 OR le%=0
  3301.         gerade2:
  3302.         DRAW 27,210
  3303.         FOR i%=27 TO 612
  3304.           rausch=RANDOM(zufall)
  3305.           r%=210+CINT(rausch-zufall/2)
  3306.           IF r%>360
  3307.             r%=360
  3308.           ENDIF
  3309.           IF r%<60
  3310.             r%=60
  3311.           ENDIF
  3312.           DRAW  TO i%,r%
  3313.         NEXT i%
  3314.         gerade!=TRUE
  3315.         GOTO rauschende
  3316.       ELSE
  3317.         IF le%>bi%
  3318.           ende%=bi%
  3319.         ELSE
  3320.           ende%=le%
  3321.         ENDIF
  3322.       ENDIF
  3323.       '
  3324.       DRAW 27,210
  3325.       FOR i%=27 TO start%
  3326.         rausch=RANDOM(zufall)
  3327.         r%=210+CINT(rausch-zufall/2)
  3328.         IF r%>360
  3329.           r%=360
  3330.         ENDIF
  3331.         IF r%<60
  3332.           r%=60
  3333.         ENDIF
  3334.         DRAW  TO i%,r%
  3335.       NEXT i%
  3336.       '
  3337.       FOR l%=anfang% TO ende%
  3338.         rausch=RANDOM(zufall)
  3339.         x%=(l%-anfang%)*fak+start%
  3340.         y%=210+huelk%(kurve%-1,l%)*hoehe*ver
  3341.         r%=y%+CINT(rausch-zufall/2)
  3342.         IF r%>360
  3343.           r%=360
  3344.         ENDIF
  3345.         IF r%<60
  3346.           r%=60
  3347.         ENDIF
  3348.         DRAW  TO x%,r%
  3349.       NEXT l%
  3350.       FOR i%=x% TO 612
  3351.         rausch=RANDOM(zufall)
  3352.         r%=210+CINT(rausch-zufall/2)
  3353.         IF r%>360
  3354.           r%=360
  3355.         ENDIF
  3356.         IF r%<60
  3357.           r%=60
  3358.         ENDIF
  3359.         DRAW  TO i%,r%
  3360.       NEXT i%
  3361.     ENDIF
  3362.     rauschende:
  3363.     HIDEM
  3364.     SGET x1$
  3365.     SHOWM
  3366.   ENDIF
  3367.   warnix:
  3368.   BOUNDARY 1
  3369.   BOUNDARY 1
  3370.   '
  3371. RETURN
  3372. '
  3373. '
  3374. ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3375. PROCEDURE laufwerk
  3376.   LOCAL l$,al%,x%,k%,i%,lx%,maus%,auswahl!
  3377.   CLS
  3378.   DEFTEXT 1,0,0,13
  3379.   l$=BIN$(BIOS(10))
  3380.   al%=GEMDOS(25)
  3381.   k%=LEN(l$)
  3382.   start:
  3383.   al%=k%-al%
  3384.   BOX 140,100,500,140
  3385.   TEXT 160,125,320," Aktuelles Laufwerk :"
  3386.   BOX 200,300,440,340
  3387.   TEXT 220,325,200," In Ordnung so ?"
  3388.   BOX 140,200,500,240
  3389.   BOX 140,40,500,80
  3390.   FOR i%=1 TO 8
  3391.     x%=140+40*i%
  3392.     LINE x%,200,x%,240
  3393.   NEXT i%
  3394.   TEXT 160,225,320,"ABCDEFGHI"
  3395.   FOR i%=k% TO 8
  3396.     x%=160+40*i%
  3397.     DEFFILL 1,2,9
  3398.     FILL x%,230,1
  3399.   NEXT i%
  3400.   x%=120+40*k%
  3401.   FOR i%=k% TO 1 STEP -1
  3402.     IF i%<>al%
  3403.       IF MID$(l$,i%,1)="0"
  3404.         DEFFILL 1,2,9
  3405.       ELSE
  3406.         DEFFILL 1,2,2
  3407.       ENDIF
  3408.       x%=160+40*(k%-i%)
  3409.       FILL x%,230,1
  3410.     ENDIF
  3411.   NEXT i%
  3412.   laufschleife:
  3413.   maus%=0
  3414.   DO UNTIL maus%>0
  3415.     IF INKEY$=CHR$(13)
  3416.       maus%=2
  3417.     ENDIF
  3418.     IF MOUSEK=1
  3419.       IF MOUSEY>200 AND MOUSEY<240 AND MOUSEX>140 AND MOUSEX<500
  3420.         auswahl!=-1
  3421.         lx%=MOUSEX
  3422.         SUB lx%,140
  3423.         DIV lx%,40
  3424.         INC lx%
  3425.         maus%=1
  3426.       ENDIF
  3427.       IF MOUSEY>300 AND MOUSEX>200 AND MOUSEX<440 AND MOUSEY<340
  3428.         maus%=2
  3429.       ENDIF
  3430.     ENDIF
  3431.   LOOP
  3432.   IF maus%=1
  3433.     IF lx%>k%
  3434.       GOTO laufschleife
  3435.     ENDIF
  3436.     DEC lx%
  3437.     IF MID$(l$,(k%-lx%),1)="0"
  3438.       GOTO laufschleife
  3439.     ELSE
  3440.       al%=lx%
  3441.     ENDIF
  3442.     CLS
  3443.     GOTO start
  3444.   ENDIF
  3445.   laufende:
  3446.   IF auswahl!=-1
  3447.     CHDRIVE lx%+1
  3448.   ENDIF
  3449.   al%=DFREE(0)
  3450.   TEXT 160,65,320,"NOCH "+STR$(al%)+" BYTE PLATZ AUF DER DISKETTE"
  3451.   GOSUB datenordner
  3452.   DO UNTIL (MOUSEK>0) OR (INKEY$>"")
  3453.   LOOP
  3454.   CLS
  3455. RETURN
  3456. '
  3457. ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3458. PROCEDURE datenordner
  3459.   CHDIR "\"
  3460.   IF 0<>FSFIRST("daten",-1)
  3461.     MKDIR "DATEN"
  3462.   ENDIF
  3463.   CHDIR "\DATEN"
  3464. RETURN
  3465. '
  3466. ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3467. '
  3468. '
  3469. '   *****************************************************************
  3470. '    MANIPULATIOENEN MIT GEMESSENEN SPEKTREN
  3471. '   *****************************************************************
  3472. '
  3473. '
  3474. PROCEDURE esp300
  3475.   LOCAL par!,butt%,parwahl$,bu%,but%,b%,button%,btton%,buttn%,maus%
  3476.   LOCAL spek!,a$,b$,c$,parwahl$,punkt%,bakl%,d%,abut%,par$,specfile$
  3477.   LOCAL spec%,spc$,smax%,smin%,pech!,l%,i%,e%,spunkte%,f,al%,res!,abutt%,n,z%
  3478.   LOCAL bcd%,bcf%,bce%,ab%,ba%,kuck1!,kuck2!,bc%,bb%,gr,messfak,param!,dr%,x%,y%
  3479.   LOCAL laenge%
  3480.   DEFTEXT 1,0,0,13
  3481.   inpeingabe:
  3482.   ALERT 2," | WAS SOLL GELESEN WERDEN ? ",0,"PARAME| SPEKTR | NIX ",butt%
  3483.   IF butt%=3
  3484.     GOTO convende
  3485.   ENDIF
  3486.   IF butt%=1
  3487.     select1:
  3488.     IF spek!=-1
  3489.       c$=b$+".PAR"
  3490.     ELSE
  3491.       c$=""
  3492.     ENDIF
  3493.     FILESELECT "A:\*.par",c$,parwahl$
  3494.     IF parwahl$>""
  3495.       IF NOT EXIST(parwahl$)
  3496.         ALERT 1,parwahl$+":|Diese Datei existiert nicht!",1," ZURÜCK  ",button%
  3497.         GOTO select1
  3498.       ENDIF
  3499.       ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3500.       a$=parwahl$
  3501.       punkt%=RINSTR(a$,".")
  3502.       bakl%=RINSTR(a$,"\")
  3503.       d%=punkt%-bakl%-1
  3504.       a$=MID$(a$,bakl%+1,d%)
  3505.       IF spek!=-1
  3506.         IF a$<>b$
  3507.           ALERT 3," "+a$+" SOLL DER | PARAMETERFILE ZUM | SPEKTRENFILE "+b$+" |    SEIN ???",1," NEE | SO ISSES",abut%
  3508.           IF abut%=1
  3509.             GOTO select1
  3510.           ENDIF
  3511.         ENDIF
  3512.       ENDIF
  3513.       ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3514.       CLR spsw,res%
  3515.       OPEN "I",#1,parwahl$
  3516.       z%=0
  3517.       DO
  3518.         INPUT #1,par$
  3519.         IF par$=""
  3520.           INC z%
  3521.         ENDIF
  3522.         EXIT IF z%=2
  3523.         PRINT par$
  3524.         IF LEFT$(par$,3)="HSW"
  3525.           spsw=ROUND(VAL(MID$(par$,4)),2)
  3526.         ENDIF
  3527.         IF LEFT$(par$,3)="GSI"
  3528.           spsw=ROUND(VAL(MID$(par$,4)),2)
  3529.         ENDIF
  3530.         IF LEFT$(par$,3)="HCF"
  3531.           cf=ROUND(VAL(MID$(par$,4)),2)
  3532.         ENDIF
  3533.         IF LEFT$(par$,3)="GST"
  3534.           lirand=ROUND(VAL(MID$(par$,4)),2)
  3535.         ENDIF
  3536.         IF LEFT$(par$,3)="RES"
  3537.           res%=VAL(MID$(par$,4))
  3538.         ENDIF
  3539.       LOOP
  3540.       IF cf=0
  3541.         CLS
  3542.         PRINT AT(20,10);" CENTERFILED IST NICHT | DEFFINIERT!! "
  3543.         PRINT AT(20,15);
  3544.         INPUT "CENTERFIELD: ";cf
  3545.       ENDIF
  3546.       IF spsw=0
  3547.         IF lirand>0
  3548.           spsw=ROUND(2*(cf-lirand),2)
  3549.         ENDIF
  3550.       ENDIF
  3551.       par!=TRUE
  3552.       CLOSE
  3553.       mess!=0
  3554.     ELSE
  3555.       GOTO inpeingabe
  3556.     ENDIF
  3557.     IF spek!=0
  3558.       GOTO inpeingabe
  3559.     ENDIF
  3560.   ENDIF
  3561.   IF butt%=2
  3562.     IF par!=FALSE
  3563.       ALERT 3," | | PARAMETER SIND NOCH  |  NICHT GELESEN !",1," OH JE |NA UND ",buttn%
  3564.       IF buttn%=1
  3565.         GOTO inpeingabe
  3566.       ENDIF
  3567.     ENDIF
  3568.     select2:
  3569.     IF par!=-1
  3570.       c$=a$+".BIN"
  3571.     ELSE
  3572.       c$=""
  3573.     ENDIF
  3574.     FILESELECT "A:\*.BIN",c$,specfile$
  3575.     IF specfile$>""
  3576.       IF NOT EXIST(specfile$)
  3577.         ALERT 1,specfile$+":|Diese Datei existiert nicht!",1," ZURÜCK ",btton%
  3578.         GOTO select2
  3579.       ENDIF
  3580.       ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3581.       b$=specfile$
  3582.       punkt%=RINSTR(b$,".")
  3583.       bakl%=RINSTR(b$,"\")
  3584.       d%=punkt%-bakl%-1
  3585.       b$=MID$(b$,bakl%+1,d%)
  3586.       IF par!=-1
  3587.         IF a$<>b$
  3588.           ALERT 3," "+a$+" SOLL DER | PARAMETERFILE ZUM | SPEKTRENFILE "+b$+" |    SEIN ???",1," NEE | SO ISSES",abut%
  3589.           IF abut%=1
  3590.             GOTO select2
  3591.           ENDIF
  3592.         ENDIF
  3593.       ENDIF
  3594.       ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3595.       ERASE spek%()
  3596.       DIM spec%(9000)
  3597.       ERASE spektrum%()
  3598.       ERASE dif%()
  3599.       OPEN "i",#1,specfile$
  3600.       l%=0
  3601.       laenge%=LOF(#1)
  3602.       DO
  3603.         EXIT IF laenge%-LOC(#1)<76
  3604.         INPUT #1,spc$
  3605.         IF LEFT$(spc$,2)="S1"
  3606.           FOR i%=9 TO 65 STEP 8
  3607.             INC l%
  3608.             IF l%<=9000
  3609.               spec%(l%)=VAL("&"+MID$(spc$,i%,8))
  3610.               IF spec%(l%)>smax%
  3611.                 smax%=spec%(l%)
  3612.               ENDIF
  3613.               IF spec%(l%)<smin%
  3614.                 smin%=spec%(l%)
  3615.               ENDIF
  3616.             ELSE
  3617.               pech!=-1
  3618.             ENDIF
  3619.           NEXT i%
  3620.         ENDIF
  3621.       LOOP
  3622.       spek!=-1
  3623.       CLOSE
  3624.       mess!=0
  3625.       CLS
  3626.       IF pech!=-1
  3627.         ALERT 3," DATEI ENTHÄLT MEHR ALS | 9000 STÜTZSTELLEN DAS | KANN NICHT SEIN !",1," ENDE ",e%
  3628.         CLOSE
  3629.         GOTO convende
  3630.       ENDIF
  3631.       '
  3632.       spunkte%=l%
  3633.       ' **************** Hier wird gerechnet !
  3634.       '
  3635.       DIM spektrum%(spunkte%)
  3636.       f=ADD(ABS(smin%),smax%)/2
  3637.       f=1000000/f
  3638.       FOR i%=1 TO spunkte%
  3639.         spektrum%(i%)=CINT(spec%(i%)*f)
  3640.       NEXT i%
  3641.       ERASE spec%()
  3642.       '
  3643.       ' ******************************************************************
  3644.       '
  3645.       '
  3646.     ELSE
  3647.       GOTO inpeingabe
  3648.     ENDIF
  3649.   ENDIF
  3650.   '
  3651.   ' ***************** Hier wird überprüft !
  3652.   IF par!=0
  3653.     ALERT 3," PARAMETER SIND IMMER | NOCH NICHT GELESEN! ",1,"JA DOCH | KUCKEN | NA UND ",al%
  3654.     IF al%=1
  3655.       GOTO inpeingabe
  3656.     ENDIF
  3657.     IF al%=2
  3658.       param!=-1
  3659.       GOTO kucken
  3660.     ENDIF
  3661.   ENDIF
  3662.   IF res%>0
  3663.     res!=-1
  3664.   ENDIF
  3665.   n$=STR$(spunkte%)
  3666.   res$=STR$(res%)
  3667.   IF res!=-1
  3668.     IF res%<>spunkte%
  3669.       IF res%<spunkte% AND res%<0
  3670.         ALERT 3," DAS IST JA OBER FAUL ! | | MEHR STÜTZSTELLEN ("+n$+") | ALS RESOLUTION ("+res$+")",1," KO |NUN DENN ",abutt%
  3671.         IF abutt%=1
  3672.           GOTO convende
  3673.         ENDIF
  3674.       ENDIF
  3675.     ENDIF
  3676.   ENDIF
  3677.   n=spunkte%/1024
  3678.   IF n>8
  3679.     ALERT 3," DA STIMMT WAS NICHT! | ES SIND "+n$+" | STÜTZSTELLEN VORHANDEN | ALSO ZUVIELE ",1,"SCH...",b%
  3680.     GOTO convende
  3681.   ENDIF
  3682.   IF n==1 OR n==2 OR n==4 OR n==8
  3683.   ELSE
  3684.     ALERT 3," DA STIMMT WAS NICHT ! | ES SIND NUR "+n$+" | STÜTZSTELLEN VORHANDEN !",1,"AENDERN| GUTSO | SCH...",bu%
  3685.   ENDIF
  3686.   IF bu%=3
  3687.     GOTO convende
  3688.   ENDIF
  3689.   IF bu%=2
  3690.     ALERT 1," | DAS GIBT JA DOCH NUR | |       MIST ! ",1," JA DOCH | DENKSTE ",but%
  3691.     IF but%=1
  3692.       GOTO convende
  3693.     ELSE
  3694.       ALERT 2," ES WURDEN "+n$+" | STÜTZSTELLEN GELESEN ",1," OK | NEIN ",bcd%
  3695.       IF bcd%=1
  3696.         res%=spunkte%
  3697.       ELSE
  3698.         IF res%>0
  3699.           ALERT 1," IN DER PARAMETERLISTE | IST DIE AUFLÖSUNG MIT | "+res$+" ANGEGEBEN !",1," OK | NEIN ",bcf%
  3700.           IF bcf%=1
  3701.             GOTO wech
  3702.           ENDIF
  3703.         ENDIF
  3704.         PRINT AT(30,13);
  3705.         INPUT " AUFLÖSUNG: ",res%
  3706.       ENDIF
  3707.       wech:
  3708.     ENDIF
  3709.   ENDIF
  3710.   IF bu%=1
  3711.     ALERT 2," ES WURDEN "+n$+" | STÜTZSTELLEN GELESEN ",1," OK | NEIN ",bce%
  3712.     IF bce%=1
  3713.       res%=spunkte%
  3714.     ELSE
  3715.       IF res%>0
  3716.         ALERT 1," IN DER PARAMETERLISTE | IST DIE AUFLÖSUNG MIT | "+res$+" ANGEGEBEN !",1," OK | NEIN ",bcf%
  3717.         IF bcf%=1
  3718.           GOTO wecher
  3719.         ENDIF
  3720.       ENDIF
  3721.       PRINT AT(30,13);
  3722.       INPUT " AUFLÖSUNG: ",res%
  3723.     ENDIF
  3724.     wecher:
  3725.   ENDIF
  3726.   '
  3727.   IF par!=0
  3728.     ALERT 3," | PARAMETER LESEN! ",1," JA DOCH | NA UND ",ab%
  3729.     IF ab%=1
  3730.       GOTO inpeingabe
  3731.     ENDIF
  3732.   ENDIF
  3733.   def:
  3734.   IF res%=0
  3735.     ALERT 3," | DIE AUFLÖSUNG IST | NICHT DEFINIERT ! ",1," KUCKEN | SETZEN | NIX DA ",ba%
  3736.     IF ba%=3
  3737.       GOTO convende
  3738.     ENDIF
  3739.     IF ba%=1
  3740.       kuck1!=-1
  3741.       GOTO kucken
  3742.     ENDIF
  3743.     IF ba%=2
  3744.       ALERT 1," ES WURDEN "+n$+" | STÜTZSTELLEN GELESEN ",1," OK | NEIN ",bc%
  3745.       IF bc%=1
  3746.         res%=spunkte%
  3747.       ELSE
  3748.         PRINT AT(30,13);
  3749.         INPUT " AUFLÖSUNG: ",res%
  3750.       ENDIF
  3751.       kuck1!=0
  3752.     ENDIF
  3753.   ENDIF
  3754.   IF spsw=0
  3755.     ALERT 3," | DIE SWEEP-WEITE IST | NICHT DEFINIERT ! ",1," KUCKEN | SETZEN | NIX DA ",bb%
  3756.     IF bb%=3
  3757.       GOTO convende
  3758.     ENDIF
  3759.     IF bb%=1
  3760.       kuck2!=-1
  3761.       GOTO kucken
  3762.     ENDIF
  3763.     IF bb%=2
  3764.       PRINT AT(30,13);
  3765.       INPUT " SWEEP-WEITE: ";spsw
  3766.       kuck2!=0
  3767.     ENDIF
  3768.   ENDIF
  3769.   '
  3770.   IF kuck1!=-1 OR kuck2!=-1
  3771.     kucken:
  3772.     ' *************** Hier wird gezeichnet !
  3773.     CLS
  3774.     '
  3775.     DEFLINE 1,1
  3776.     gr=150/1000000
  3777.     messfak=586/spunkte%
  3778.     DRAW 27,210
  3779.     FOR i%=1 TO spunkte%
  3780.       x%=i%*messfak+27
  3781.       y%=CINT(210-spektrum%(i%)*gr)
  3782.       DRAW  TO x%,y%
  3783.     NEXT i%
  3784.     DO UNTIL maus%=1
  3785.       IF MOUSEK>0
  3786.         maus%=1
  3787.       ENDIF
  3788.     LOOP
  3789.     IF param!=-1
  3790.       param!=0
  3791.       GOTO inpeingabe
  3792.     ENDIF
  3793.     IF kuck1!=-1 OR kuck2!=-1
  3794.       GOTO def
  3795.     ENDIF
  3796.     '
  3797.     ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3798.   ENDIF
  3799.   CLS
  3800.   '
  3801.   DIM spek%(res%)
  3802.   IF res%>=spunkte%
  3803.     daten%=spunkte%
  3804.   ELSE
  3805.     daten%=res%
  3806.   ENDIF
  3807.   '
  3808.   l%=1
  3809.   DO UNTIL l%=daten%+1
  3810.     spek%(l%)=spektrum%(l%)
  3811.     spek%(l%)=spektrum%(l%)
  3812.     INC l%
  3813.   LOOP
  3814.   ERASE spektrum%()
  3815.   mess$=a$
  3816.   GOSUB messpektrum
  3817.   mess!=TRUE
  3818.   messtart%=0
  3819.   MENU 38,3
  3820.   MENU 41,3
  3821.   MENU 42,3
  3822.   MENU 43,3
  3823.   ' *****************************************************************
  3824.   convende:
  3825. RETURN
  3826. '
  3827. '
  3828. '
  3829. '
  3830. PROCEDURE messlese
  3831.   LOCAL button%,wahl$,punkt%,bakl%,d%,l$
  3832.   DEFTEXT 1,0,0,13
  3833.   select3:
  3834.   l$=CHR$(GEMDOS(25)+65)
  3835.   FILESELECT l$+":\*.SPC","",wahl$
  3836.   IF wahl$>""
  3837.     IF NOT EXIST(wahl$)
  3838.       ALERT 1,wahl$+":|Diese Datei existiert nicht!",1," ZURÜCK  ",button%
  3839.       GOTO select3
  3840.     ENDIF
  3841.     ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3842.     ERASE spek%()
  3843.     ERASE dif%()
  3844.     VOID FRE(0)
  3845.     OPEN "I",#1,wahl$
  3846.     INPUT #1,spsw,res%,cf
  3847.     DIM spek%(res%)
  3848.     BGET #1,VARPTR(spek%(0)),DIM?(spek%())*4
  3849.     CLOSE
  3850.     mess!=-1
  3851.     MENU 38,3
  3852.     MENU 41,3
  3853.     MENU 42,3
  3854.     MENU 43,3
  3855.     ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3856.     punkt%=RINSTR(wahl$,".")
  3857.     bakl%=RINSTR(wahl$,"\")
  3858.     d%=punkt%-bakl%-1
  3859.     mess$=MID$(wahl$,bakl%+1,d%)
  3860.     ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
  3861.     messtart%=0
  3862.     GOSUB messpektrum
  3863.   ENDIF
  3864. RETURN
  3865. '
  3866. '
  3867. PROCEDURE messchreiben
  3868.   LOCAL wahl$,button%,l$
  3869.   IF mess!=-1
  3870.     select4:
  3871.     l$=CHR$(GEMDOS(25)+65)
  3872.     FILESELECT l$+":\*.SPC",mess$+".SPC",wahl$
  3873.     VOID FRE(0)
  3874.     IF wahl$>""
  3875.       IF EXIST(wahl$)
  3876.         ALERT 1,wahl$+":|Diese Datei existiert schon!",1," ZURÜCK | WEITER ",button%
  3877.         IF button%=1
  3878.           GOTO select4
  3879.         ENDIF
  3880.       ENDIF
  3881.       OPEN "O",#1,wahl$
  3882.       WRITE #1,spsw,res%,cf
  3883.       BPUT #1,VARPTR(spek%(0)),DIM?(spek%())*4
  3884.       CLOSE
  3885.     ENDIF
  3886.   ENDIF
  3887. RETURN
  3888. '
  3889. '
  3890. PROCEDURE messpektrum
  3891.   MENU OFF
  3892.   LOCAL i%,l%,x%,y%,gr%,maus%,dr%,y1%,pix%,ver%
  3893.   ver%=1
  3894.   DEFTEXT 1,0,0,6
  3895.   DEFLINE 1,1
  3896.   zeigen:
  3897.   gr=150/1000000
  3898.   messfak=586/res%
  3899.   DRAW 27,210
  3900.   FOR i%=1 TO res%
  3901.     x%=i%*messfak+27
  3902.     y%=CINT(210-spek%(i%)*gr)
  3903.     DRAW  TO x%,y%
  3904.   NEXT i%
  3905.   GET 27,50,613,390,aus$
  3906.   CLS
  3907.   BOX 27,60,613,360
  3908.   LINE 27,210,613,210
  3909.   LINE 27,360,27,365
  3910.   LINE 613,360,613,365
  3911.   manf=ROUND((cf-spsw/2),2)
  3912.   mend=ROUND((cf+spsw/2),2)
  3913.   TEXT 10,375,manf
  3914.   TEXT 580,375,mend
  3915.   PRINT AT(3,2);" Spektrum: ";mess$;
  3916.   PRINT AT(40,2);" Auflösung: ";res%;
  3917.   PRINT AT(3,5);" Gemessene Sweep-Weite: ";spsw;
  3918.   BOX 300,30,400,45
  3919.   BOX 500,30,600,45
  3920.   TEXT 310,40,80,"IN ORDNUNG ?"
  3921.   TEXT 510,40,80," VERÄNDERN "
  3922.   HIDEM
  3923.   SGET x1$
  3924.   SHOWM
  3925.   PUT 27,50,aus$,7
  3926.   maus%=0
  3927.   DO UNTIL maus%>0
  3928.     IF MOUSEK=1
  3929.       IF MOUSEY>30 AND MOUSEY<45
  3930.         IF MOUSEX>300 AND MOUSEX<400
  3931.           maus%=1
  3932.         ENDIF
  3933.         IF MOUSEX>500 AND MOUSEX<600
  3934.           maus%=2
  3935.         ENDIF
  3936.       ENDIF
  3937.     ENDIF
  3938.   LOOP
  3939.   IF maus%=2
  3940.     ALERT 2," | WAS DENN NU SCHON WIEDER ?  ",2," GRÖßE | DREHEN | HÖHE ",dr%
  3941.     IF dr%=1
  3942.       BOX 614,60,631,360
  3943.       LINE 615,210,630,210
  3944.       DO UNTIL MOUSEK=2
  3945.         DO WHILE MOUSEK=1
  3946.           DEFLINE 1,3
  3947.           DEFFILL 0,0
  3948.           IF MOUSEY>59 AND MOUSEY<361
  3949.             y%=MOUSEY-210
  3950.             ver%=-y%
  3951.             u%=210+y%
  3952.             o%=210-ver%
  3953.             IF u%<=210
  3954.               u%=210
  3955.             ENDIF
  3956.             IF o%>=210
  3957.               o%=210
  3958.             ENDIF
  3959.             LINE 622,210,622,210+y%
  3960.             PBOX 615,60,630,o%
  3961.             PBOX 615,360,630,u%
  3962.             DEFLINE 1,1
  3963.             BOX 614,60,631,360
  3964.             LINE 615,210,630,210
  3965.           ENDIF
  3966.         LOOP
  3967.       LOOP
  3968.       IF ver%=0
  3969.         ver%=1
  3970.       ENDIF
  3971.       mul=ver%
  3972.       mul=ABS(mul/10)
  3973.       IF mul<1
  3974.         mul=1
  3975.       ENDIF
  3976.       IF ver%<0
  3977.         mul=1/mul
  3978.       ENDIF
  3979.       '
  3980.       l%=1
  3981.       DO UNTIL l%=res%+1
  3982.         spek%(l%)=CINT(spek%(l%)*mul)
  3983.         INC l%
  3984.       LOOP
  3985.       CLS
  3986.       GOTO zeigen
  3987.     ENDIF
  3988.     IF dr%=2
  3989.       l%=1
  3990.       DO UNTIL l%=res%+1
  3991.         spek%(l%)=-spek%(l%)
  3992.         INC l%
  3993.       LOOP
  3994.       CLS
  3995.       GOTO zeigen
  3996.     ENDIF
  3997.     '
  3998.     IF dr%=3
  3999.       '
  4000.       y1%=50
  4001.       DO UNTIL MOUSEK=2
  4002.         DEFMOUSE bitmuster$
  4003.         y%=MOUSEY-y1%
  4004.         IF MOUSEK=1
  4005.           my%=MOUSEY
  4006.           DO UNTIL MOUSEK=0
  4007.             DEFMOUSE 4
  4008.             y1%=SUB(MOUSEY,y%)
  4009.             SPUT x1$
  4010.             PUT 27,y1%,aus$,7
  4011.             PAUSE 8
  4012.           LOOP
  4013.         ENDIF
  4014.       LOOP
  4015.       pix%=CINT((50-y1%)/gr)
  4016.       l%=1
  4017.       DO UNTIL l%=res%+1
  4018.         ADD spek%(l%),pix%
  4019.         INC l%
  4020.       LOOP
  4021.       CLS
  4022.       GOTO zeigen
  4023.     ENDIF
  4024.   ENDIF
  4025.   SPUT x1$
  4026.   DEFFILL 0
  4027.   PBOX 28,61,612,359
  4028.   DEFLINE 1,1
  4029.   PUT 27,50,aus$,7
  4030.   HIDEM
  4031.   SGET x1$
  4032.   SHOWM
  4033.   MENU 35,3
  4034.   MENU 36,3
  4035.   CLS
  4036.   IF simm!=-1
  4037.     MENU 44,3
  4038.   ENDIF
  4039.   mstart%=1
  4040.   mende%=res%
  4041.   messfak=586/res%
  4042.   huell!=0
  4043.   bereichsplott!=0
  4044.   simess!=0
  4045.   messplo!=-1
  4046.   messbereich!=0
  4047.   MENU 37,3
  4048. RETURN
  4049. '
  4050. PROCEDURE espspektrum
  4051.   halb!=0
  4052.   MENU OFF
  4053.   MENU 38,3
  4054.   esp:
  4055.   CLS
  4056.   LOCAL i%,x%,y%
  4057.   verg=1
  4058.   offset%=0
  4059.   IF 0=(messbereich! OR zentrier!)
  4060.     mstart%=1
  4061.     mende%=res%
  4062.     messfak=586/res%
  4063.     manf=ROUND((cf-spsw/2),2)
  4064.     mend=ROUND((cf+spsw/2),2)
  4065.   ENDIF
  4066.   GOSUB espzeichnung
  4067.   DEFTEXT 1,0,0,6
  4068.   DEFLINE 1,1
  4069.   gr=150/1000000
  4070.   BOX 27,60,613,360
  4071.   LINE 27,360,27,365
  4072.   LINE 613,360,613,365
  4073.   TEXT 10,375,ROUND(manf,2)
  4074.   TEXT 580,375,ROUND(mend,2)
  4075.   TEXT 300,375,STR$(ROUND(mend-manf,2))+" "+"Gauss"
  4076.   PRINT AT(3,2);" Spektrum: ";mess$;
  4077.   PRINT AT(40,2);" Auflösung: ";res%;
  4078.   PRINT AT(3,5);" Gemessene Sweep-Weite: ";spsw;
  4079.   ALERT 2," | ALLES IN ORDNUNG ? | ",1," JAJAJA | RESET ",butt%
  4080.   IF butt%=2
  4081.     messbereich!=0
  4082.     zentrier!=0
  4083.     GOTO esp
  4084.   ENDIF
  4085.   HIDEM
  4086.   SGET x1$
  4087.   SHOWM
  4088.   huell!=0
  4089.   bereichsplott!=0
  4090.   simess!=0
  4091.   messplo!=-1
  4092. RETURN
  4093. '
  4094. PROCEDURE espzeichnung
  4095.   DEFLINE 1,1
  4096.   gr=150/1000000
  4097.   DRAW 27,210-offset%
  4098.   IF mstart%<res%
  4099.     FOR i%=mstart% TO mende%
  4100.       IF i%<res%
  4101.         x%=(i%-mstart%)*messfak+27
  4102.         IF i%<1
  4103.           y%=210-offset%
  4104.         ELSE
  4105.           y%=CINT(210-offset%-spek%(i%)*gr*verg)
  4106.         ENDIF
  4107.         IF x%>=27
  4108.           IF y%>360
  4109.             y%=360
  4110.           ENDIF
  4111.           IF halb!=-1
  4112.             IF y%>210
  4113.               y%=210
  4114.             ENDIF
  4115.           ENDIF
  4116.           IF y%<60
  4117.             y%=60
  4118.           ENDIF
  4119.           DRAW  TO x%,y%
  4120.         ENDIF
  4121.         IF x%>613
  4122.           i%=mende%
  4123.         ENDIF
  4124.       ENDIF
  4125.     NEXT i%
  4126.   ENDIF
  4127.   IF simess!=-1
  4128.     HIDEM
  4129.     IF halb!=0
  4130.       GET 27,50,613,390,aus$
  4131.     ELSE
  4132.       GET 27,50,613,230,aus$
  4133.     ENDIF
  4134.     SHOWM
  4135.   ENDIF
  4136. RETURN
  4137. '
  4138. '
  4139. PROCEDURE spekmessbereich
  4140.   MENU OFF
  4141.   CLS
  4142.   LOCAL maus%,key$,x1,x2,messbereich%,li%,re%,lix,rex,auf,g1,g2
  4143.   LOCAL l%,anf
  4144.   halb!=0
  4145.   stpg=res%/spsw
  4146.   anf=manf
  4147.   messbereich!=0
  4148.   messbereichanfang:
  4149.   IF messbereich!=FALSE
  4150.     verg=1
  4151.     offset%=0
  4152.     g1=0
  4153.     g2=spsw
  4154.     mstart%=1
  4155.     mende%=res%
  4156.     messfak=586/res%
  4157.     manf=ROUND((cf-spsw/2),2)
  4158.     mend=ROUND((cf+spsw/2),2)
  4159.     DEFLINE 1,1,0,0
  4160.     BOX 27,60,613,360
  4161.     LINE 27,360,27,365
  4162.     LINE 321,360,321,365
  4163.     LINE 613,360,613,365
  4164.     DEFTEXT 1,0,0,6
  4165.     PRINT AT(3,2);" Spektrum: ";mess$;
  4166.     PRINT AT(40,2);"Auflösung: ";res%;
  4167.     PRINT AT(3,5);"Gemessene Sweep Width :";spsw;
  4168.     TEXT 18,375,ROUND(manf,2)
  4169.     TEXT 580,375,ROUND(mend,2)
  4170.     TEXT 300,375,STR$(ROUND(mend-manf,2))+" "+"Gauss"
  4171.     GOSUB espzeichnung
  4172.     HIDEM
  4173.     SGET x1$
  4174.     SHOWM
  4175.   ENDIF
  4176.   anf=manf
  4177.   BOX 580,35,613,55
  4178.   DEFTEXT 1,1,0,13
  4179.   TEXT 583,50,25,"ESC"
  4180.   DEFTEXT 1,1,0,6
  4181.   maus%=0
  4182.   DO
  4183.     key$=INKEY$
  4184.     IF key$=CHR$(27)
  4185.       maus%=3
  4186.     ENDIF
  4187.     IF key$=CHR$(127)
  4188.       maus%=2
  4189.     ENDIF
  4190.     IF MOUSEK>0
  4191.       maus%=1
  4192.     ENDIF
  4193.     IF MOUSEX>580 AND MOUSEY>35
  4194.       IF MOUSEX<613 AND MOUSEY<55 AND MOUSEK>0
  4195.         maus%=3
  4196.       ENDIF
  4197.     ENDIF
  4198.     EXIT IF maus%>0
  4199.     key$=""
  4200.   LOOP
  4201.   IF maus%=3
  4202.     CLS
  4203.     GOTO messbereichende
  4204.   ENDIF
  4205.   IF maus%=2
  4206.     CLS
  4207.     messbereich!=0
  4208.     GOTO messbereichanfang
  4209.   ENDIF
  4210.   HIDEM
  4211.   SGET x1$
  4212.   SHOWM
  4213.   DEFLINE 2,1,1,1
  4214.   SETMOUSE 321,200,0
  4215.   messbereich!=-1
  4216.   micks1:
  4217.   DO                      !Abfrage der linken Grenze
  4218.     SPUT x1$
  4219.     x1=MOUSEX
  4220.     li%=MOUSEX-27
  4221.     IF li%<0
  4222.       li%=0
  4223.     ENDIF
  4224.     IF li%>586
  4225.       li%=586
  4226.     ENDIF
  4227.     lix=ROUND(((g2-g1)/586*li%),2)
  4228.     PRINT AT(4,7);lix+anf
  4229.     lix=lix+g1
  4230.     COLOR 1
  4231.     LINE x1,60,x1,360
  4232.     PAUSE 5
  4233.     IF MOUSEK=1
  4234.       COLOR 1
  4235.       LINE x1,60,x1,360
  4236.       lin=1
  4237.       HIDEM
  4238.       SGET x1$
  4239.       SHOWM
  4240.     ENDIF
  4241.     EXIT IF lin=1
  4242.   LOOP
  4243.   IF x1<27 OR x1>613
  4244.     GOTO micks1
  4245.   ENDIF
  4246.   micks2:
  4247.   maus%=0
  4248.   DO
  4249.     SPUT x1$
  4250.     x2=MOUSEX
  4251.     re%=MOUSEX-27
  4252.     IF re%<0
  4253.       re%=0
  4254.     ENDIF
  4255.     IF re%>586
  4256.       re%=586
  4257.     ENDIF
  4258.     rex=ROUND(((g2-g1)/586*re%),2)
  4259.     PRINT AT(14,7);rex+anf
  4260.     rex=rex+g1
  4261.     PRINT AT(24,7);ROUND(rex-lix,2);
  4262.     COLOR 1
  4263.     LINE x2,60,x2,360
  4264.     PAUSE 5
  4265.     COLOR 1
  4266.     IF MOUSEK=2
  4267.       LINE x2,60,x2,360
  4268.       lin=2
  4269.     ENDIF
  4270.     EXIT IF lin=2
  4271.   LOOP
  4272.   IF x1=x2
  4273.     GOTO micks2
  4274.   ENDIF
  4275.   IF x2<x1 OR x2>614
  4276.     GOTO micks2
  4277.   ENDIF
  4278.   '
  4279.   '
  4280.   mstart%=CINT(lix*stpg)
  4281.   mende%=CINT(rex*stpg)
  4282.   messbereich%=mende%-mstart%
  4283.   IF messbereich%=0
  4284.     GOTO micks1
  4285.   ENDIF
  4286.   messfak=586/messbereich%
  4287.   mend=ROUND(rex+anf,2)
  4288.   manf=ROUND(lix+anf,2)
  4289.   g1=lix
  4290.   g2=rex
  4291.   '
  4292.   CLS
  4293.   DEFLINE 1,1,0,0
  4294.   BOX 27,60,613,360
  4295.   LINE 27,360,27,365
  4296.   LINE 321,360,321,365
  4297.   LINE 613,360,613,365
  4298.   DEFTEXT 1,0,0,6
  4299.   PRINT AT(3,2);" Spektrum: ";mess$;
  4300.   PRINT AT(40,2);"Auflösung: ";res%;
  4301.   PRINT AT(3,5);"Gemessene Sweep Width :";spsw;
  4302.   TEXT 18,375,ROUND(manf,2)
  4303.   TEXT 580,375,ROUND(mend,2)
  4304.   TEXT 300,375,STR$(ROUND((mend-manf),2))+" "+"Gauss"
  4305.   '
  4306.   GOSUB espzeichnung
  4307.   HIDEM
  4308.   SGET x1$
  4309.   SHOWM
  4310.   GOTO messbereichanfang
  4311.   '
  4312.   messbereichende:
  4313.   huell!=0
  4314.   bereichsplott!=0
  4315.   messbereich!=-1
  4316.   simess!=0
  4317.   messplo!=-1
  4318.   DEFLINE 1,1,0,0
  4319. RETURN
  4320. '
  4321. '
  4322. '
  4323. '
  4324. PROCEDURE simmess
  4325.   MENU OFF
  4326.   LOCAL altver,x%,x1%,y%,y1%,maus%,mst%,dummy%,messtart%,gpst,l%
  4327.   gpst=spsw/res%
  4328.   '
  4329.   CLS
  4330.   halb!=-1
  4331.   DEFTEXT 1,0,0,13
  4332.   BOX 80,80,520,110
  4333.   TEXT 100,100,400,"LINIENFORM DES SIMULIERTEN SPEKTRUMS"
  4334.   BOX 80,110,520,120
  4335.   DEFFILL 1,0
  4336.   PBOX 400,200,500,250
  4337.   DEFFILL 1,1
  4338.   PBOX 250,200,350,250
  4339.   TEXT 260,230,"IN ORDNUNG"
  4340.   PBOX 100,200,200,250
  4341.   TEXT 135,230,"HALB"
  4342.   TEXT 435,230,"VOLL"
  4343.   DEFLINE defl%,1
  4344.   LINE 100,115,500,115
  4345.   maus%=0
  4346.   DO UNTIL maus%=1
  4347.     IF INKEY$=CHR$(13)
  4348.       maus%=1
  4349.     ENDIF
  4350.     IF MOUSEK=1
  4351.       IF MOUSEY>80 AND MOUSEY<120
  4352.         INC defl%
  4353.         IF defl%>6
  4354.           defl%=1
  4355.         ENDIF
  4356.         DEFFILL 0,0
  4357.         PBOX 82,112,518,118
  4358.         DEFLINE defl%,1
  4359.         LINE 100,115,500,115
  4360.         PAUSE 10
  4361.       ENDIF
  4362.       IF MOUSEY>200 AND MOUSEY<250
  4363.         IF MOUSEX>400 AND MOUSEX<500
  4364.           DEFFILL 0,0
  4365.           PBOX 101,201,199,249
  4366.           TEXT 135,230,"HALB"
  4367.           DEFFILL 1,1
  4368.           PBOX 401,201,499,249
  4369.           TEXT 435,230,"VOLL"
  4370.           halb!=0
  4371.         ENDIF
  4372.         IF MOUSEX>100 AND MOUSEX<200
  4373.           DEFFILL 1,1
  4374.           PBOX 101,201,199,249
  4375.           TEXT 135,230,"HALB"
  4376.           DEFFILL 0,0
  4377.           PBOX 401,201,499,249
  4378.           TEXT 435,230,"VOLL"
  4379.           halb!=-1
  4380.         ENDIF
  4381.         IF MOUSEX>250 AND MOUSEX<350
  4382.           maus%=1
  4383.         ENDIF
  4384.       ENDIF
  4385.     ENDIF
  4386.   LOOP
  4387.   CLS
  4388.   '
  4389.   simess!=-1
  4390.   altver=ver
  4391.   IF halb!=-1
  4392.     offset%=75
  4393.     ver=0.5*ver
  4394.     verg=0.5
  4395.   ELSE
  4396.     verg=1
  4397.     offset%=0
  4398.   ENDIF
  4399.   GOSUB espzeichnung
  4400.   CLS
  4401.   IF spektrum!=-1
  4402.     GOSUB bild
  4403.   ELSE
  4404.     IF kurve%=0
  4405.       ALERT 3," KURVENFORM IST NICHT | DEFINIERT !!!!!! ",1," IS GUT ",l%
  4406.       GOTO simessende
  4407.     ENDIF
  4408.     GOSUB pinsel
  4409.   ENDIF
  4410.   '
  4411.   zentrier:
  4412.   CLS
  4413.   DEFTEXT 1,0,0,6
  4414.   DEFLINE 1,1
  4415.   SPUT x1$
  4416.   BOX 27,60,613,360
  4417.   LINE 27,55,27,365
  4418.   LINE 613,55,613,365
  4419.   LINE 321,60,321,55
  4420.   TEXT 20,370,STR$(amb)
  4421.   TEXT 600,370,STR$(mb)
  4422.   TEXT 300,370,STR$(ROUND(mb-amb,2))+" GAUSS"
  4423.   TEXT 10,55,STR$(ROUND(manf,2))
  4424.   TEXT 580,55,STR$(ROUND(mend,2))
  4425.   TEXT 300,55,STR$(ROUND(mend-manf,2))+" "+"Gauss"
  4426.   HIDEM
  4427.   SGET x1$
  4428.   SHOWM
  4429.   PUT 27,50,aus$,7
  4430.   x1%=27
  4431.   y1%=50
  4432.   beginn:
  4433.   DEFLINE 1,1
  4434.   DEFTEXT 1,0,0,6
  4435.   BOX 20,20,120,40
  4436.   BOX 250,20,350,40
  4437.   BOX 480,20,580,40
  4438.   TEXT 30,33,80,"IN ORDNUNG"
  4439.   TEXT 260,33,80,"VERSCHIEBEN"
  4440.   TEXT 490,33,80,"ZENTRIEREN"
  4441.   maus%=0
  4442.   DO UNTIL maus%>0
  4443.     IF MOUSEK=1 AND MOUSEY>20 AND MOUSEY<40
  4444.       IF MOUSEX>20 AND MOUSEX<120
  4445.         maus%=1
  4446.       ENDIF
  4447.       IF MOUSEX>250 AND MOUSEX<350
  4448.         maus%=2
  4449.       ENDIF
  4450.       IF MOUSEX>480 AND MOUSEX<580
  4451.         maus%=3
  4452.       ENDIF
  4453.     ENDIF
  4454.   LOOP
  4455.   IF maus%=1
  4456.     GOTO simessende
  4457.   ENDIF
  4458.   IF maus%=2
  4459.     DEFMOUSE 4
  4460.     DO UNTIL MOUSEK=2
  4461.       x%=MOUSEX-x1%
  4462.       y%=MOUSEY-y1%
  4463.       IF MOUSEK=1
  4464.         DO UNTIL MOUSEK=0
  4465.           x1%=SUB(MOUSEX,x%)
  4466.           y1%=SUB(MOUSEY,y%)
  4467.           IF y1%<0
  4468.             y1%=0
  4469.           ENDIF
  4470.           SPUT x1$
  4471.           PUT x1%,y1%,aus$,7
  4472.           PAUSE 8
  4473.         LOOP
  4474.       ENDIF
  4475.     LOOP
  4476.     DEFMOUSE bitmuster$
  4477.   ENDIF
  4478.   IF maus%=3
  4479.     messtart%=x1%-27
  4480.     SUB mstart%,CINT(messtart%/messfak)
  4481.     SUB mende%,CINT(messtart%/messfak)
  4482.     manf=ROUND((mstart%-1)*gpst,2)
  4483.     ADD manf,(cf-spsw/2)
  4484.     mend=ROUND((mende%-mstart%)*gpst+manf,2)
  4485.     CLS
  4486.     zentrier!=-1
  4487.     GOSUB espzeichnung
  4488.     CLS
  4489.     GOSUB pinsel
  4490.     GOTO zentrier
  4491.   ENDIF
  4492.   GOTO beginn
  4493.   simessende:
  4494.   DEFFILL 0,0
  4495.   PBOX 0,0,581,41
  4496.   TEXT 340,20,280,"simuliertes Spektrum: "+finame$
  4497.   TEXT 20,20,280,"gemessenes Spektrum : "+mess$
  4498.   TEXT 400,35,"Linienzug: "
  4499.   DEFLINE defl%,1
  4500.   LINE 500,33,600,33
  4501.   TEXT 20,35,"Linienzug: "
  4502.   DEFLINE 1,1,0,0
  4503.   LINE 120,33,220,33
  4504.   ver=altver
  4505.   offset%=0
  4506.   HIDEM
  4507.   SGET x1$
  4508.   SHOWM
  4509.   messplo!=-1
  4510. RETURN
  4511. '
  4512. '
  4513. PROCEDURE sichnum
  4514.   MENU OFF
  4515.   DEFLINE 1,1,0,0
  4516.   DEFTEXT 1,0,0,13
  4517.   LOCAL mfak,sfak,sichstart%,xpixel%,xa%,l%,x%,y%,z%,aus$,ok!,vgl
  4518.   LOCAL beschriftung$,l$,r$
  4519.   verg=1
  4520.   vgl=ver
  4521.   xpixel%=(start%-27)*2
  4522.   gr=150/1000000
  4523.   hoehe=gr
  4524.   mfak=messfak*2
  4525.   sfak=fak*2
  4526.   IF (bereichsplott! OR huell!) OR simess!
  4527.     beschriftung$="SIMULIERT: "+finame$
  4528.     l$=STR$(ROUND(amb,2))
  4529.     r$=STR$(ROUND(mb,2))
  4530.     IF messplo!=-1
  4531.       ok!=-1
  4532.       ALERT 2," | GRAPHMODE |    ? | ",2," 1 | 2 ",but%
  4533.       IF but%=1
  4534.         GRAPHMODE 1
  4535.       ELSE
  4536.         GRAPHMODE 2
  4537.       ENDIF
  4538.       IF halb!=-1
  4539.         offset%=75
  4540.         verg=0.5
  4541.         vgl=ver*0.5
  4542.       ENDIF
  4543.     ELSE
  4544.       ok!=0
  4545.       verg=1
  4546.       offset%=0
  4547.       vgl=ver
  4548.       defl%=1
  4549.     ENDIF
  4550.   ENDIF
  4551.   FOR z%=1 TO 2    !  ***********************************
  4552.     DEFLINE 1,1,0,0
  4553.     CLS
  4554.     LINE 27,60,613,60
  4555.     LINE 27,360,613,360
  4556.     IF z%=1
  4557.       IF ok!=-1
  4558.         LINE 27,50,27,380
  4559.       ELSE
  4560.         LINE 27,60,27,380
  4561.       ENDIF
  4562.       LINE 613,360,613,380
  4563.       xa%=27
  4564.       sichstart%=xa%+xpixel%
  4565.     ELSE
  4566.       IF ok!=-1
  4567.         LINE 613,50,613,380
  4568.       ELSE
  4569.         LINE 613,60,613,380
  4570.       ENDIF
  4571.       LINE 27,360,27,380
  4572.       xa%=-559
  4573.       sichstart%=xa%+xpixel%
  4574.     ENDIF
  4575.     IF messplo!=-1
  4576.       beschriftung$="GEMESSEN: "+mess$+".SPC"
  4577.       l$=STR$(ROUND(manf,2))
  4578.       r$=STR$(ROUND(mend,2))
  4579.       messspek:
  4580.       IF mstart%<res%
  4581.         IF mstart%>1
  4582.           st%=spek%(mstart%)
  4583.         ELSE
  4584.           st%=0
  4585.         ENDIF
  4586.         DRAW xa%,CINT(210-offset%-st%*gr*verg)
  4587.         FOR i%=mstart% TO mende%
  4588.           IF i%<res%
  4589.             x%=(i%-mstart%)*mfak+xa%
  4590.             IF i%<1
  4591.               y%=210-offset%
  4592.             ELSE
  4593.               y%=CINT(210-offset%-spek%(i%)*gr*verg)
  4594.             ENDIF
  4595.             IF y%>360
  4596.               y%=360
  4597.             ENDIF
  4598.             IF halb!=-1
  4599.               IF y%>210
  4600.                 y%=210
  4601.               ENDIF
  4602.             ENDIF
  4603.             IF y%<60
  4604.               y%=60
  4605.             ENDIF
  4606.             IF x%>0 AND x%<640
  4607.               DRAW  TO x%,y%
  4608.             ENDIF
  4609.           ENDIF
  4610.         NEXT i%
  4611.       ENDIF
  4612.       IF ok!=-1
  4613.         GOTO simspek
  4614.       ENDIF
  4615.     ELSE
  4616.       simspek:
  4617.       DEFLINE defl%,1,0,0
  4618.       IF p_line!=-1
  4619.         LINE 27,210+offset%,613,210+offset%
  4620.         gerade!=-1
  4621.       ELSE
  4622.         gerade!=0
  4623.         DRAW xa%,210+offset%
  4624.         DRAW  TO sichstart%,210+offset%
  4625.         FOR l%=anfang% TO ende%
  4626.           x%=(l%-anfang%)*sfak+sichstart%
  4627.           y%=210+offset%+huelk%(kurve%-1,l%)*hoehe*vgl
  4628.           IF y%>360
  4629.             y%=360
  4630.           ENDIF
  4631.           IF y%<60
  4632.             y%=60
  4633.           ENDIF
  4634.           IF halb!=-1
  4635.             IF y%<210
  4636.               y%=210
  4637.             ENDIF
  4638.           ENDIF
  4639.           IF x%>0 AND x%<640
  4640.             DRAW  TO x%,y%
  4641.           ENDIF
  4642.         NEXT l%
  4643.         IF x%<613
  4644.           DRAW  TO 613,210+offset%
  4645.         ENDIF
  4646.       ENDIF
  4647.     ENDIF
  4648.     HIDEM
  4649.     GET 27,50,613,390,aus$
  4650.     SHOWM
  4651.     CLS
  4652.     PUT 27,30,aus$
  4653.     IF ok!=-1
  4654.       IF z%=1
  4655.         DEFLINE 1,1,0,0
  4656.         LINE 400,18,600,18
  4657.         BOX 400,10,600,25
  4658.         TEXT 10,25,STR$(manf)
  4659.         TEXT 150,25,200,"GEMESSEN: "+mess$+".SPC"
  4660.         TEXT 25,370,STR$(ROUND(amb,2))
  4661.       ELSE
  4662.         DEFLINE defl%,1,0,0
  4663.         LINE 300,18,500,18
  4664.         DEFLINE 1,1,0,0
  4665.         BOX 300,10,500,25
  4666.         TEXT 50,25,200,"SIMULIERT :"+finame$
  4667.         TEXT 570,25,STR$(mend)
  4668.         TEXT 600,370,STR$(ROUND(mb,2))
  4669.       ENDIF
  4670.     ELSE
  4671.       IF z%=1
  4672.         TEXT 150,25,200,beschriftung$
  4673.         TEXT 25,370,l$
  4674.       ELSE
  4675.         TEXT 50,25,200,beschriftung$
  4676.         TEXT 625-(LEN(r$)*8),370,r$
  4677.       ENDIF
  4678.     ENDIF
  4679.     HIDEM
  4680.     SGET x1$
  4681.     SHOWM
  4682.     GOSUB pixel
  4683.   NEXT z%  !***********************************************************
  4684.   DEFLINE 1,1,0,0
  4685.   offset%=0
  4686.   GRAPHMODE 1
  4687. RETURN
  4688.